ERROR: The LRECL= value is out of range, found 0.00000E-309.

レアケースのエラーにぶつかったのでメモしておきます。PROC OPTMODELのエラーです。

ERROR: The LRECL= value is out of range, found 0.00000E-309. 

これLRECLを指定する箇所ないのに、レンジがおかしいとエラーになっています。広く事例を調べてみると、この極端に小さな値0.00000E-309.は、ひょこひょことOPTMODEL以外でも出ています。

原因は、入力データセットの中に必要な変数がなかったことによるものでした。よく分からない論理レコード長のエラーがでたら、入力データの変数を疑うという経験則を得ました。

Enterprise Guide, UACダイアログが出る現象

トラブル対応のメモです。 EGを実行すると必ずUACのダイアログが表示され、管理者のパスワード入力を促されるという事象にぶつかりました。 原因は、SEGuide.exeのプロパティで、[管理者としてこのプログラムを実行する」というオプションが設定されていたためです。 このプロパティ、他のPCでは設定されていないので、何故チェックが入ったのかは不明です。



Keyword: UAC dialog, User Account Contorol, EG, Enterprise Guide, SEGuide.exe

VBScriptでタスクスケジューラの複数のタスクをXMLに出力、削除、作成

EGで登録したスケジュールのタスクを、他のユーザへ定期的に引き渡すためにVBScriptを組みました。特定のタスクをXMLファイルに出力、削除、登録します。

SCHTASKSを使っていますが、これ１つの操作で１タスクしか定義できません。じゃあPowerShellで書こうかと思ったのですが、お客様先の環境だと使えないことが多いためVBScriptで書きました。

• tasks_list.vbs でXMLファイルを作成
• tasks_delete.vbs でタスクを削除
• tasks_create.vbs でタスクを作成

キーワードを含む名前のタスクをXML形式で出力します。

'----
' Windowsのタスク スケジューラから指定された名前のタスクをXML形式で表示します。
' 標準出力にはログ、標準エラー出力にはXMLを出力します。
' 使用例: C:\Windows\System32\cscript //b c:\temp\tasks_list.vbs 1> tasks.log 2> tasks.xml
'----

Option Explicit
Dim objShell
Dim objExec 
Dim objDictionary
Dim objFso
Dim strLine
Dim strCmd
Dim Count
Dim Name
Dim QuitCode
Const MINIMIZE_WINDOW = 2
Const SCHTASKS = "C:\Windows\System32\SCHTASKS.EXE"
Const KEYWORD = "スケジュール - "

'----
' チェック関数
'----

Function CheckError(fnName)
    CheckError = False
    
    Dim strmsg
    Dim errNum
    
    If Err.Number <> 0 Then
        strmsg = "ERROE: #" & Hex(Err.Number) & " in module " & fnName & " " & Err.Description
        WScript.Stdout.WriteLine strmsg
        CheckError = True
    End If
         
End Function

'----
' オブジェクト生成
'----

Set objShell = WScript.CreateObject("WScript.Shell")
Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")

'----
' タスク一覧表示
'----

Sub Main()
    Dim ExitCode
    Dim ErrCount

    '----
    ' タスク一覧から削除対象のタスク名を取得
    '----

    Set objExec = objShell.Exec(SCHTASKS & " /query /fo:csv")
    Count = 0
    Do Until objExec.StdOut.AtEndOfStream
        strLine = objExec.StdOut.ReadLine
        If InStr(strLine, KEYWORD) <> 0 Then
            Count = Count + 1
            objDictionary.Add Count, Mid(strLine, 1, InStr(strLine, ""","))
        End If
    Loop
    If objExec.ExitCode <> 0 Then
        Do Until objExec.StdErr.AtEndOfStream
            WScript.StdOut.WriteLine objExec.StdErr.ReadLine
        Loop
        Err.Raise(51)
    End If
    Set objExec = Nothing

    '----
    ' 件数を出力
    '----

    WScript.StdOut.WriteLine "NOTE: found " & Count & " tasks to export."

    '----
    ' タスクをXML形式で表示
    '----

    For Each Name In objDictionary.Keys
        strCmd = SCHTASKS & " /query /xml /tn:" & objDictionary(Name)
        WScript.StdOut.WriteLine strCmd
        Set objExec = objShell.Exec(strCmd)
        WScript.StdErr.WriteLine("")
        Do Until objExec.StdOut.AtEndOfStream
            WScript.StdErr.WriteLine(objExec.StdOut.ReadLine)
        Loop
        WScript.StdErr.WriteLine("")

        If objExec.ExitCode <> 0 Then
            Do Until objExec.StdErr.AtEndOfStream
                WScript.StdOut.WriteLine objExec.StdErr.ReadLine
            Loop
            Err.Raise(51)
        End If
        Set objExec = Nothing
    Next

End Sub

'----
' 処理実行
'----

Sub Try()
    Call Main()
End Sub

'----
' エラー捕捉
'----

Sub Catch()
    On Error Resume Next
    Call Try()
End Sub

'----
' 処理実行
'----

QuitCode=0
WScript.StdOut.WriteLine "NOTE: script=" & WScript.ScriptFullName & " date=" & Now()
Call Catch()
If CheckError("Catch") Then
    QuitCode = 1
End If

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

Set objShell = Nothing
Set objDictionary = Nothing
Set objFso = Nothing
WScript.StdOut.WriteLine "NOTE: script finished with exit code " & QuitCode
WScript.Quit QuitCode

特定の名前のタスクを削除します。

'----
' Windowsのタスク スケジューラから指定された名前のタスクを削除します。
' 標準出力に削除のログを出力します。
' 使用例: C:\Windows\System32\cscript //b c:\temp\tasks_delete.vbs > tasks_delete_%date:~-2,2%.log
'----

Option Explicit
Dim objShell
Dim objExec 
Dim objDictionary
Dim objFso
Dim strLine
Dim strCmd
Dim Count
Dim Name
Dim objFile
Dim QuitCode
Const SCSHTASKS = "C:\Windows\System32\SCHTASKS.EXE"

'----
' 削除するタスク名の名前
'----

Const KEYWORD = "スケジュール - "

'----
' チェック関数
'----

Function CheckError(fnName)
    CheckError = False
    
    Dim strmsg
    Dim errNum
    
    If Err.Number <> 0 Then
        strmsg = "ERROE: #" & Hex(Err.Number) & " in module " & fnName & " " & Err.Description
        WScript.Stdout.WriteLine strmsg
        CheckError = True
    End If
         
End Function

'----
' オブジェクト生成
'----

Set objShell = WScript.CreateObject("WScript.Shell")
Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")

'----
' タスク削除
'----

Sub Main()
    Dim ExitCode
    Dim ErrCount

    '----
    ' タスク一覧から削除対象のタスク名を取得
    '----

    Set objExec = objShell.Exec(SCSHTASKS & " /query /fo:csv")
    Count = 0
    Do Until objExec.StdOut.AtEndOfStream
        strLine = objExec.StdOut.ReadLine
        If InStr(strLine, KEYWORD) <> 0 Then
            Count = Count + 1
            objDictionary.Add Count, Mid(strLine, 1, InStr(strLine, ""","))
        End If
    Loop
    If objExec.ExitCode <> 0 Then
        Do Until objExec.StdErr.AtEndOfStream
            WScript.StdOut.WriteLine objExec.StdErr.ReadLine
        Loop
        Err.Raise(51)
    End If
    Set objExec = Nothing

    '----
    ' 件数を出力
    '----

    WScript.StdOut.WriteLine "NOTE: found " & Count & " tasks to delete."

    '----
    ' タスクを削除
    '----

    For Each Name In objDictionary.Keys
        strCmd = SCSHTASKS & " /delete /f /tn " & objDictionary(Name)
        WScript.StdOut.WriteLine strCmd
        Set objExec = objShell.Exec(strCmd)

        Do Until objExec.StdOut.AtEndOfStream
            WScript.StdOut.WriteLine objExec.StdOut.ReadLine
        Loop

        If objExec.ExitCode <> 0 Then
            Do Until objExec.StdErr.AtEndOfStream
                WScript.StdOut.WriteLine objExec.StdErr.ReadLine
            Loop
            Err.Raise(51)
        End If
        Set objExec = Nothing
    Next

End Sub

'----
' 処理実行
'----

Sub Try()
    Call Main()
End Sub

'----
' エラー捕捉
'----

Sub Catch()
    On Error Resume Next
    Call Try()
End Sub

'----
' 処理実行
'----

QuitCode = 0
WScript.StdOut.WriteLine "NOTE: script=" & WScript.ScriptFullName & " date=" & Now()
Call Catch()
If CheckError("Catch") Then
    QuitCode = 1
End If

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

Set objShell = Nothing
Set objDictionary = Nothing
Set objFso = Nothing
WScript.StdOut.WriteLine "NOTE: script finished with exit code " & QuitCode
WScript.Quit QuitCode

XMLファイルからタスクを作成します。

'----
' WindowsのタスクをXMLファイルから定義します。
' 引数に tasks_list.vbs で作成したXMLファイルを指定します。
' タスクの実行ユーザは、スクリプトの実行者に置き換えられます。
' 使用例: C:\Windows\System32\cscript //b c:\temp\tasks_create.vbs tasks.xml
'----

Option Explicit
Dim objShell
Dim objExec 
Dim objDictionary
Dim objFso
Dim strLine
Dim strCmd
Dim Count
Dim Name
Dim objFile
Dim xmlFile
Dim QuitCode
Const SCSHTASKS = "C:\Windows\System32\SCHTASKS.EXE"

'----
' 実行ユーザのキーワード
'----

Const KEYWORD = "      "

'----
' チェック関数
'----

Function CheckError(fnName)
    CheckError = False
    
    Dim strmsg
    Dim errNum
    
    If Err.Number <> 0 Then
        strmsg = "ERROE: #" & Hex(Err.Number) & " in module " & fnName & " " & Err.Description
        WScript.Stdout.WriteLine strmsg
        CheckError = True
    End If
         
End Function

'----
' XMLのコメントからユーザ名を取得
'----

Function XmlUserName(Buf)
    Dim Pos1, Pos2
    Const Keyword1 = "username="
    Const Keyword2 = " -->"

    XmlUserName = "N/A"

    Pos1 = InStr(Buf, Keyword1)
    Pos2 = InStr(Buf, Keyword2)
    If Pos1 <> 0 And Pos2 <> 0 Then
        XmlUserName = Mid(Buf, Pos1 + Len(Keyword1), Pos2 - (Pos1 + Len(Keyword1)))
    End If
End Function

'----
' XMLのコメントからタスク名を取得
'----

Function XmlTaskName(Buf)
    Dim Pos1, Pos2
    Dim AryStrings
    Const Keyword1 = "<!-- end "
    Const Keyword2 = "username="

    XmlTaskName = "N/A"

    Pos1 = InStr(Buf, Keyword1)
    Pos2 = InStr(Buf, Keyword2)
    If Pos1 <> 0 And Pos2 <> 0 Then
        XmlTaskName = Trim(Mid(Buf, Pos1 + Len(Keyword1), Pos2 - (Pos1 + Len(Keyword1))))
        XmlTaskName = Mid(XmlTaskName, 2, Len(XmlTaskName) - 2)

        AryStrings = Split(XmlTaskName, "\")
        XmlTaskName = AryStrings(UBound(AryStrings))
    End If
End Function

'----
' オブジェクト生成
'----

Set objShell = WScript.CreateObject("WScript.Shell")
Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")

'----
' タスク定義
'----

Sub Main()
    Dim UserName
    Dim TaskName
    Dim FilePath

    '----
    ' テンポラリファイルのパスを設定
    '----
    FilePath = objShell.ExpandEnvironmentStrings("%TEMP%") & "\task.xml"

    '----
    ' 引数のXMLファイルを開く
    '----
    If WScript.Arguments.Count <> 1 Then
        Err.Rase(51)
    End If
    Set objFile = objFso.OpenTextFile(WScript.Arguments.Item(0))

    Count = 0
    strLine = objFile.ReadLine
    Do Until objFile.AtEndOfStream
        If InStr(strLine, "<!-- begin") <> 0 Then
            Set xmlFile = objFSO.OpenTextFile(FilePath, 2, True)
            strLine = objFile.ReadLine
            Do Until objFile.AtEndOfStream or (InStr(strLine, "<!-- end") <> 0)
                ' ユーザIDを書き換える
                If InStr(strLine, KEYWORD) = 1 Then
                    strLine = "      " & objShell.ExpandEnvironmentStrings("%USERDOMAIN%") & "\" & objShell.ExpandEnvironmentStrings("%USERNAME%") & ""
                End If
                xmlFile.WriteLine strLine
                strLine = objFile.ReadLine
            Loop
            UserName = xmlUserName(strLine)
            TaskName = xmlTaskName(strLine)
            xmlFile.Close

            '----
            ' タスク登録
            '----
            Count = Count + 1
            strCmd = SCSHTASKS & " /create /xml """ & FilePath & """ /tn:""EG\" & UserName & "." & Right("000" & Count, 3) & " " & TaskName & """"
            WScript.StdOut.WriteLine strCmd
            Set objExec = objShell.Exec(strCmd)

            Do Until objExec.StdOut.AtEndOfStream
                WScript.StdOut.WriteLine objExec.StdOut.ReadLine
            Loop
            If objExec.ExitCode <> 0 Then
                Do Until objExec.StdErr.AtEndOfStream
                    WScript.StdOut.WriteLine objExec.StdErr.ReadLine
                Loop
                Err.Raise(51)
            End If
            Set objExec = Nothing

        End If
        If objFile.AtEndOfStream = False Then
            strLine = objFile.ReadLine
        End If
    Loop

    '----
    ' 件数を出力
    '----

    WScript.StdOut.WriteLine "NOTE: create " & Count & " tasks."

    '----
    ' テンポラリのXMLファイルを削除
    '----
    objFso.DeleteFile FilePath, True

End Sub

'----
' 処理実行
'----

Sub Try()
    Call Main()
End Sub

'----
' エラー捕捉
'----

Sub Catch()
    On Error Resume Next
    Call Try()
End Sub

'----
' 処理実行
'----

QuitCode = 0
WScript.StdOut.WriteLine "NOTE: script=" & WScript.ScriptFullName & " date=" & Now()
Call Catch()
If CheckError("Catch") Then
    QuitCode = 1
End If

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

Set objShell = Nothing
Set objDictionary = Nothing
Set objFso = Nothing
WScript.StdOut.WriteLine "NOTE: script finished with exit code " & QuitCode
WScript.Quit QuitCode

RPM - Rapid Predictive Modeler

10年ぶりのEnterprise Miner

久しぶりにEnterprise Minerを使ったら、RPMなる便利な機能が付いてました。10年以上前にSAS Enterprise Minerのトレーニングを受けたものの、仕事ではSPSS Modeler(Clementine)ばかりを使っていました。しばらく会えなかった友人（又は恋人）に再開したような気持ちです。

RPMとは何か？

Enterprise Guideのデータに対して目的変数、説明変数を設定し、予測モデルを作ってくれる機能です。データ加工はEGの上で行って、EMのプロジェクトはRPMで作ることができます。モデル作成の機能が割り切りよく、基本、中間、詳細の3段階というのが良いです。

できたモデルをEGから参照して、スコアリングできます。細かい調整をしたい人は、EMからプロジェクトを開いて修正します。モデル作成で詳細を指定すると、回帰、決定木と複数のモデルを作成して比較してくれます。とはいえ、実際に使うモデルの手法は、業務や分析者で決まってしまうとは思いますが。

Rev up your RPMs; A Modeling Sampler動画

RPMがどんなものかは、下の動画を見れば、一目瞭然かと思います。
Part 1
Part 2
Part 3

SAS Log Utility 1.8.1.1, ログファイルのエンコーディングを判定

Vectorに新しいバージョンの公開を依頼しました。今回の修正内容は以下のとおりです。

• 不具合の修正
• SASログファイルのエンコーディングを自動判定
• SJIS, JIS, EUC, UTF8N, UTF8, UTF7など複数のエンコーディングに対応
• Optionsのメニューの構成を変更
• 日本語のマッチングパターン(keyword.ini)を訂正

ログファイルのエンコーディング判定は、ココの情報が役立ちました。これが無ければ、短時間で実装できなかったです。

ListViewのソートは、DEBUGのシンボルを定義したときと、外したときで動作が異なっていました。原因分からず。機能的には、だいぶ落ち着いてきたと思います。そろそろメジャーバージョンを上げて、処理構造の無駄を取り除きたいです。

EncodeDetect.pas

開発のメモです。
ログファイルのエンコーディング判定の関数、下にネタがあります。

EncodeDetect : EncodeDetectリファレンス

http://www.watercolor-city.net/ct_delphi/delphi_tiburon/doc_thirdparty/tp_ed_ref.htm

これを使ってコードを判定、TEncodeingを生成した後します。
StringListからEncodingを指定して、読み取ると正しく読み取れました。
試しにElapsed Timeの表示に組み込んだらあっさりと動きました。

ZIP圧縮のファイルを書く

投稿を修正して再度掲載します。

HULFT転送されてきたテキストファイルを読み込んでデータセット化するときに、元のファイルは残しておきたいことがあります。そのときに、圧縮して保存しとくと容量削減できて良いです。下のサンプルは、お馴染みCLASSのデータを使ったものです。名前と年齢をZIPファイルに出力し、後半のDATAステップでZIPファイルから読み取っています。

23   filename foo ZIP 'C:\temp\testzip.zip';
24
25   /* write to zip file */
26   data _null_;
27       file foo(class);
28       set sashelp.class;
29       put name age;
30   run;
 
NOTE: ファイルライブラリFOO :
      Directory=C:\temp\testzip.zip
 
NOTE: 出力ファイルFOO(class) :
      Filename=C:\temp\testzip.zip,
      Member Name=class
 
NOTE: 19レコードをファイルライブラリFOOに書き込みました。
      最小レコード長は9です。
      最大レコード長は15です。
NOTE: 19レコードを出力ファイルFOO(class)に書き込みました。
      最小レコード長は9です。
      最大レコード長は15です。
NOTE: データセットSASHELP.CLASSから19オブザベーションを読み込みました。
NOTE: DATAステートメント処理(合計処理時間):
      処理時間           0.01 秒
      CPU時間            0.01 秒
 
 
31
32   /* read from zip file */
33   data work.class;
34       infile foo(class);
35       input name $ age;
36   run;
 
NOTE: 入力ファイルライブラリFOO:
      Directory=C:\temp\testzip.zip
 
NOTE: 入力ファイルFOO(class) :
      Filename=C:\temp\testzip.zip,
      Member Name=class
 
NOTE: 19レコードを入力ファイルライブラリFOOから読み込みました。
      最小レコード長は9です。
      最大レコード長は15です。
NOTE: 19レコードを入力ファイルFOO(class)から読み込みました。
      最小レコード長は9です。
      最大レコード長は15です。
NOTE: データセットWORK.CLASSは19オブザベーション、2変数です。
NOTE: DATAステートメント処理(合計処理時間):
      処理時間           0.01 秒
      CPU時間            0.01 秒

便利！