2010/01/03

アレ対応版・・・


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

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

で、今朝・・・ つーか深夜だけど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) >

0 件のコメント:

コメントを投稿