アレ対応版･･･

前の版で困難だった、ネットワークドライブ／フォルダ上のファイルアクセスも容易にする為、
対象ファイル読み込み処理だけ、ADODB.Streamから FileSystemObject.OpenTextFileに差し替えました。

以前のログにも記述した通り、ADODB.Streamでは、どう処理の順序を変えても、
ネットワーク先からローカルドライブへ、無条件にテンポラリってしまい、
大量のファイルを連続処理するのはおろか、１つのファイルだけでも多大な時間を要していたのです。

で、今朝･･･ つーか深夜だけどw　夜通しでFSO版を試作してみて、その問題の解消に至りました。
やっぱり餅は餅屋、ファイルアクセスなら、DB向けオブジェクト使うより、FSOってコトですかね･･･(^_^;)
って、書き込みとかはADOのままですケドww以下はアーカイブです。

    X3FSIR.zip βReleaseArchive - 20100103 0739 launch -    
▲ を、右クリックしてファイルとして保存してください。


とは云え まだまだ、

　　　　　アクマで暫定版デスから。結局こんなん出ました～w

    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
        ' X3FSIR.vbs - X3F ShootingInformationsReader      
        ' FoveonX3 RAWファイルから、撮影情報を文字列として取得する。     
         
        ' - Created by LazwardFox -      
              
        '      
         
        ' Update -------- ----      
        ' Release      
        ' Update      
        ' βRelease      
        ' Update 20100103 0706 Source読み込み部のみ、ADODB.Streamから     
        '                       FileSystemObject.OpenTextFileに差し替えるコトで、     
        '                       ファイルへのアクセスを最小限化、LANファイルアクセス対応へ。     
        ' Update 20091231 1814 0byteファイルに因るエラーへ対策。     
        ' Update 20091231 0425 処理集約の誤りを修正。     
        ' Update 20091230 0315 複数ファイル指定に暫定対応。     
        ' Update 20091230 0130 撮影日時文字列化処理追加／テキストデータの範囲可変に対応。     
        ' αRelease 20091226 2150 単一ファイル取得版、データも内容のまま列挙。     
                                ' 日本語／最適化準備中。     
        ' DevStart 20091226 2040      
          
    '***** ↓↓↓ ObjectDecralations ↓↓↓ *************************************************     
        Option Explicit     
        Public My, Parameters, Fs, objADO ', MySh, objSMTP, objMx     
        Set My = WScript     
        With My     
            Set Parameters = .Arguments ' パラメーター取得      
            If Parameters.Count <= 0 Then ' パラメータなし起動の無効化      
                .Quit     
            End If     
         
            Set Fs = .CreateObject("Scripting.FileSystemObject")     
            Set objADO = .CreateObject("ADODB.Stream")     
            'Set MySh = .CreateObject("WScript.Shell")     
            'Set objSMTP = .CreateObject("CDO.Message") ' SMTP Object     
            'Set objMx = .CreateObject("MSXML2.XMLHTTP") ' URL Check      
        End With     
         
    '***** ↓↓↓ Decralations ↓↓↓ *************************************************     
        'Public ThisScriptFull, ThisScript, Start     
        Const vbWq = """"     
         
        ' Const - Letters      
        Dim vbWCrLf, vbTc, vbNullB     
        vbWCrLf = vbCrLf & vbCrLf     
        vbTc = vbTab & vbCrLf     
        vbNullB = chr(&h00)     
         
        ' Const - Date/Times      
         
         
    '***** ↓↓↓ LocalDecralations ↓↓↓ *************************************************     
        Dim X3FSet     
         
    '***** ↓↓↓MainRoutine↓↓↓ *********************************************************     
        'On Error Resume Next     
         
        'X3FSet = Array("X3F",, 264, 1500, "VERSION_BF", "BURST", "TIME", "1970/1/1")     
        X3FSet = Array("X3F",, 0, 1800, "VERSION_BF", "BURST", "TIME", "1970/1/1")     
        BPS Parameters, X3FSet     
         
         
        ' ----- ExitProcess      
        Set Fs = Nothing     
        Set objADO = Nothing     
        My.Quit     
         
    '***** ↓↓↓Functions↓↓↓ *********************************************************     
        ' X3FSIs      
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－      
        ' Binary Pickup to Strings      
        ' バイナリファイル中 範囲を指定し、任意の文字列群を抽出する。     
         
        ' - Created by LazwardFox -      
         
            ' Fs、objADO、cnvDateTime      
         
            ' Update      
            ' Release      
            ' βRelease      
            ' Update 20091231 1814 0byteファイルに因るエラーへ対策。     
            ' Update 20091231 0425 処理集約の誤りを修正。     
            ' Update 20091230 0315 複数ファイル指定に暫定対応。     
            ' αRelease 20091230 0300      
            ' DevStart 20091230 0200 X3FSIsを汎用用途向けに修正。     
         
            ' BPS (      
            '       arFileNames - 対象ファイル群配列。     
            '      ,arSet - 動作パラメータを、下記スキーマ準拠の配列で指定。     
            '      )      
         
         
            ' ▼▼ arSet Schema ▼▼▼▼▼     
         
            '     = Array(strEx, SaveFileName, StartBit, ReadByte, Firstkey, Lastkey, strTimeKey, BaseDate)      
         
            '    arSet      
            '        (0)    {strEx}         対象拡張子                      (String)      
            '        (1)    {SaveFileName}  保存ファイル名                  (String)      
            '        (2)     StartBit       読み取り先頭位置(Bit)           (Number)      
            '        (3)     ReadByte       読み込み範囲(byte)              (Number)      
            '        (4)     Firstkey       先頭キー名                      (String)      
            '        (5)     Lastkey        最終キー名                      (String)      
            '        (6)    {strTimeKey}    時間キー名                      (String)      
            '        (7)    {BaseDate}      時間変換基日付文字列("y/m/d")   (String)      
         
         
        Function BPS(arFileNames, arSet)      
            Dim kNothing, iADO, strTarget, Pc, fKey, rSource, rHeader, lHeader     
            Dim pResult, arResult, rUnits, sResult     
            kNothing = String(5, vbNullB) ' キーも値も存在しない範囲の、データ排除向け      
            Set iADO = objADO      
            For Each strTarget In arFileNames     
                If Fs.GetExtensionName(strTarget) = arSet(0) Then     
                    arSet(1) = Replace(strTarget,"." & arSet(0),".txt") ' ＜ 暫定      
                    Set rSource = Fs.OpenTextFile(strTarget,1)  ' 対象ファイルを読み取りモードで開く     
                    With rSource     
                        ' ファイルから指定範囲をメモリへ取得      
                        If arSet(2) > 0 Then     
                            .Skip(arSet(2)) ' 先頭位置をセット      
                        End If     
                        rHeader = .Read(arSet(3)) ' 指定範囲を取得      
                    End With     
                    Set rSource = Nothing     
                    With iADO     
                        If LenB(rHeader) > 0 Then     
                            ' Convert to PlainText      
                            rHeader = CStr(rHeader) ' 次処理に備え、文字列データ化      
                            rHeader = Replace(rHeader, "SECc", "") ' 無効キー排除      
                            rHeader = Replace(rHeader, kNothing, "") ' 無効範囲の消去      
                            .Type = 2 ' AccessMode - Text      
                            .Charset = "_autodetect" '"Shift_JIS" "Unicode" "utf-8"      
                            .Open     
                            .Position = 0     
                            .WriteText = rHeader     
                            lHeader = .Position ' 取得データ長      
                            rHeader = ""     
                            For Pc = 1 To lHeader Step 2     
                                .Position = Pc     
                                pResult = pResult & .ReadText(1)     
                            Next     
                            .Close     
                            arResult = Split(pResult, vbNullB) ' 配列化。     
                            pResult = ""     
                            For Each sResult In arResult     
                                If sResult = arSet(4) Or fKey > 0 Then ' スタートキー      
                                    If fKey = 4 Then ' 日付データ変換      
                                        sResult = cnvDateTime(arSet(7), sResult)     
                                    End If     
                                    rUnits = rUnits & sResult ' 値書き込み      
                                    ' ▼ 末尾符号／キー検出処理 ▼▼▼▼▼      
                                    If fKey < 2 Then     
                                        If sResult = arSet(5) Then ' 終了キー      
                                            fKey = 5     
                                        ElseIf sResult = arSet(6) Then ' 時刻値変換対象      
                                            fKey = 4     
                                        Else     
                                            fKey = 3     
                                        End If     
                                        rUnits = rUnits & "," ' キー末尾処理      
                                    Else     
                                        rUnits = rUnits & vbCrLf  ' データ末尾処理      
                                        If fKey = 5 Then ' 処理終了      
                                            Exit For     
                                        End If     
                                        fKey = 1     
                                    End If     
                                    ' ▲ 末尾符号／キー検出処理 ▲▲▲▲▲      
                                End If     
                                sResult = ""     
                            Next     
                            arResult = ""     
                            fKey = 0     
                            ' 指定ファイルへ書き込み      
                            .Type = 2 ' AccessMode - Text      
                            .Charset = "_autodetect"     
                            .Open     
                            .Position = 0     
                            .WriteText rUnits     
                            .SaveToFile arSet(1), 2     
                        End If     
                        .Close     
                    End With     
                    rUnits = "" ' ＜ 暫定      
                End If     
            Next     
            Set iADO = Nothing     
        End Function     
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－      
        ' cnvDateTime      
        ' 秒整数で構成された日時データを、Windowsシリアル値に変換。     
        ' 基準日の異なる値の変換にも対応。     
         
        ' - Created by LazwardFox -      
         
            '      
         
            ' Update      
            ' Release      
            ' βRelease 20091230 0300      
            ' αRelease 20091229 1635      
            ' DevStart 20091229 1500      
         
            ' cnvDateTime (      
            '               strBaseDate - "y/m/d"形式の日付文字列、基準日を指定。     
            '               ,SourceDateTime - Secベースの経過時間を表す整数      
            '               )      
         
        Function cnvDateTime(strBaseDate, SourceDateTime)     
            Dim sDate     
            sDate = DateValue(strBaseDate)     
            cnvDateTime = (((SourceDateTime / 60) / 60) / 24) + sDate     
        End Function     
         



＜ ファイルの一部へのみアクセスするなら、FileSystemObject(FSO) ＞