システムロジック教室_A1/単位_vbs(1/1)
教師A
2025-05-18 23:44:38
並列処理VBS基盤（データの受け渡しをCSVで行うタイプ、改行は不可であることに注意）
並列処理VBS基盤_20250518.html
教師A
2025-05-19 22:38:58
並列処理VBS基盤 構造

並列処理VBS基盤
│  execute.bat
│
├─data_input
│      sample.csv
│
├─data_output
│      output.csv
│
├─scripts
│      controller.vbs
│      worker.vbs
│
└─temp
教師A
2025-05-19 22:40:13
controller.vbs

Option Explicit

'パス関連
Dim rootPath, scriptSpacePath, inputDirectoryPath, outputDirectoryPath, tempDirectoryPath, readCSVPath, writeFilePath, readFilePath, writeCSVPath
'オブジェクト
Dim fso, wshShell, stream, re
'配列・データ処理関連
Dim dataOfCSV, dataOfReturn, dataOfBuffer
'カウンタ・インデックス・サイズ関連
Dim i, j, numberOfData, numberOfResultData, numberOfBuffer, numberOfOneTaskData, dataSize, bufferDataSize
'プロセス制御
Dim PROCESS_NUMBER
Dim ProcessArray(), numProcess, execCommand, sOutPut, ProcessActivateArray

'*******************************************************************************
' 定数記述
'*******************************************************************************
PROCESS_NUMBER = 8 'プロセス起動数

'グローバル変数定義
ReDim ProcessArray(PROCESS_NUMBER) 'プロセス起動情報
ReDim ProcessActivateArray(PROCESS_NUMBER)
For i = 0 To PROCESS_NUMBER - 1
    ProcessActivateArray(i) = False
Next
numProcess = 0 'トータルプロセス起動数
Set fso = CreateObject("Scripting.FileSystemObject")
Set wshShell = CreateObject("WScript.Shell")
scriptSpacePath = fso.getParentFolderName(WScript.ScriptFullName)
rootPath = fso.GetAbsolutePathName(fso.BuildPath(scriptSpacePath, ".."))

'*******************************************************************************
' 子プロセスの終了チェック
'   終了しているプロセスがないかをチェックする。
'   起動中のプロセスがある場合はFalseを返す
'*******************************************************************************
Function checkSubProcess()
    checkSubProcess = false
    For i = LBound(ProcessArray) To UBound(ProcessArray)
        'プロセスが終了しているかどうかをチェック
        If Not IsEmpty(ProcessArray(i)) Then
            If Not ProcessActivateArray(i) Then 'そもそも始まっていない
                ProcessArray(i) = Empty
            ElseIf ProcessArray(i).Status = 1 Then '"1"は終了
                sOutPut = ProcessArray(i).StdOut.ReadAll
                Call checkChildProcess(sOutPut) 'ユーザ処理 子プロセスの出力をどう調理するか
                ProcessArray(i) = Empty
            Else
                checkSubProcess = True
            End If
        End If
    Next
End Function

'*******************************************************************************
' 子プロセス起動
'*******************************************************************************
Function executeSubProcess(workerPath, index)
    If index < LBound(ProcessArray) Or index > UBound(ProcessArray) Then
        WScript.Echo "    サブプロセスエラー: 指定されたインデックスが範囲外 (" & index & ") (" & LBound(ProcessArray) & " < X <" & UBound(ProcessArray) & ")"
        startSubProcess = False
        Exit Function
    End If

    If Not IsEmpty(ProcessArray(index)) Then
        WScript.Echo "    サブプロセスエラー: プロセススロットが使用中 (" & index & " ) (" & LBound(ProcessArray) & " < X <" & UBound(ProcessArray) & ")"
        startSubProcess = False
        Exit Function
    End If

    Dim execCommand
    execCommand = "cscript //Nologo " & workerPath & " " & CStr(index + 1)
    WScript.Echo "    サブプロセス起動: " & execCommand

    On Error Resume Next
    Set ProcessArray(index) = wshShell.Exec(execCommand)
    If Err.Number <> 0 Then
        WScript.Echo "    サブプロセスエラー: 起動エラー (" & Err.Description & ")"
        startSubProcess = False
        Err.Clear
    Else
        numProcess = numProcess + 1
        startSubProcess = True
    End If
    On Error GoTo 0
End Function

'*******************************************************************************
' 起動中の子プロセスがすべて完了するまで待つ
'*******************************************************************************
Sub waitSubProcess()
    While checkSubProcess()
        WScript.Sleep 100
    Wend
End Sub

'子プロセス終了監視（呼び出し側処理）
'  子プロセスの出力結果を処理するユーザ処理を記載する。
Sub checkChildProcess(sOutPut)
    WScript.echo(sOutPut)	'出力結果をそのままコンソールに出力する
End Sub

'*******************************************************************************
' 関数処理
'*******************************************************************************
'1次元配列の配列数を求める
function len1DArray(ByRef arrayList, index)
    len1DArray = UBound(arrayList, index) - LBound(arrayList, index) + 1
End Function

' CSVファイルを読み込む
Function ReadCSVFile(filePath)
    Dim re, stream, line, fields, bufferArraySize, dataSize
    Dim bufferArray, resultArray
    bufferArraySize = 100
    dataSize = 0
    ReDim bufferArray(bufferArraySize - 1)
    
    Set stream = CreateObject("ADODB.Stream")
    Set re = New RegExp
    re.Pattern = """((?:[^""]|"""")*)""(?:,|$)"
    re.Global = True
    re.IgnoreCase = True
    With stream
        .Charset = "utf-8" 'UTF-8-SIG
        .Open
        .LoadFromFile filePath
        .Position = 0
        .Type = 2 'テキストとして扱う
        Do Until .EOS
            line = .ReadText(-2) '1行ずつ読み込み
            fields = ParseCSVLine(line, re) 'CSVをパース
            bufferArray(dataSize) = fields
            dataSize = dataSize + 1
            If dataSize = bufferArraySize - 1 Then
                bufferArraySize = CLng(bufferArraySize * 1.5)
                ReDim Preserve bufferArray(bufferArraySize - 1)
            End if
        Loop
        .Close
    End With
    Set stream = Nothing
    ReDim resultArray(dataSize - 1)
    For i = 0 To dataSize - 1
      resultArray(i) = bufferArray(i)
    Next
    ReadCSVFile = resultArray
End Function

' CSVの1行をパースする関数（ダブルクォーテーション対応）
Function ParseCSVLine(ByVal strLine, ByRef reObj)
    Dim matches, results, i
    Set matches = reObj.Execute(strLine)
    ReDim results(matches.Count - 1)
    For i = 0 To matches.Count - 1
        results(i) = Replace(matches(i).SubMatches(0), """""", """") '"" → " (エスケープしたダブルクォーテーションを保護)
    Next
    ParseCSVLine = results
End Function

'中間ファイル書き込み関数
Function WriteCSVFile(outputPath, arr)
    Dim stream, i, j, k, line, buffer, bufferArray
    
    ' ADODB.Streamオブジェクトの作成
    Set stream = CreateObject("ADODB.Stream")
    With stream
        .Type = 2 'テキストモード
        .Charset = "UTF-8" '文字コードをUTF-8(SIG)に設定
        .LineSeparator = -1 '改行コードをCRLFに設定
        .Open
        
        ' 配列の内容をストリームに書き込む
        For i = LBound(arr, 1) To UBound(arr, 1)
            ReDim bufferArray(len1DArray(arr(i), 1) - 1)
            k = 0
            For j = LBound(arr(i), 1) To UBound(arr(i), 1)
                buffer = """" & Replace(CStr(arr(i)(j)), """", """""") & """"
                bufferArray(k) = buffer
                k = k + 1
            Next
            line = Join(bufferArray, ",")
            If i = UBound(arr, 1) Then
                stream.WriteText line, 0
            Else
                stream.WriteText line, 1 '第2引数1で改行を追加
            End If
        Next
        
        ' ストリームの内容をファイルに保存
        .SaveToFile outputPath, 2 '上書き保存
        .Close
    End With
    Set stream = Nothing
End Function

'中間ファイル読み込み関数
Function ReadFileToArray(filePath)
    Dim re, stream, line, bufferArraySize, dataSize
    Dim bufferArray, resultArray, i
    
    Set stream = CreateObject("ADODB.Stream")
    bufferArraySize = 100
    dataSize = 0
    ReDim bufferArray(bufferArraySize)
    With stream
        .Charset = "utf-8" 'UTF-8-SIG
        .Open
        .LoadFromFile filePath
        .Position = 0
        .Type = 2 'テキストとして扱う
        Do Until .EOS
            line = .ReadText(-2) '1行ずつ読み込み
            bufferArray(dataSize) = Split(line, Chr(31))
            dataSize = dataSize + 1
            If dataSize = bufferArraySize Then
                bufferArraySize = CLng(bufferArraySize * 1.5)
                ReDim Preserve bufferArray(bufferArraySize)
            End if
        Loop
        .Close
    End With
    Set stream = Nothing
    ReDim resultArray(dataSize - 1)
    For i = 0 To dataSize - 1
      resultArray(i) = bufferArray(i)
    Next
    ReDim bufferArray(0)
    ReadFileToArray = resultArray
End Function

'中間ファイル書き込み関数
Function WriteArrayToUTF8File(outputPath, arr, startLineNumber, endLineNumber)
    Dim stream, i, j, line
    
    ' ADODB.Streamオブジェクトの作成
    Set stream = CreateObject("ADODB.Stream")
    With stream
        .Type = 2 'テキストモード
        .Charset = "UTF-8" '文字コードをUTF-8(SIG)に設定
        .LineSeparator = -1 '改行コードをCRLFに設定
        .Open
        
        ' 配列の内容をストリームに書き込む
        For i = startLineNumber To endLineNumber
            line = Join(arr(i), Chr(31))
            stream.WriteText line, 1 '第2引数1で改行を追加
        Next
        
        ' ストリームの内容をファイルに保存
        .SaveToFile outputPath, 2 '上書き保存
        .Close
    End With
    Set stream = Nothing
End Function
教師A
2025-05-19 22:40:17
'*******************************************************************************
' メイン処理
'*******************************************************************************
WScript.Echo("メインプロセス開始")
'処理領域確保
inputDirectoryPath = fso.BuildPath(rootPath, "data_input")
If Not fso.FolderExists(inputDirectoryPath) Then '/data_inputフォルダ確保
    fso.CreateFolder(inputDirectoryPath)
End if
outputDirectoryPath = fso.BuildPath(rootPath, "data_output")
If Not fso.FolderExists(outputDirectoryPath) Then '/data_outputフォルダ確保
    fso.CreateFolder(outputDirectoryPath)
End if
tempDirectoryPath = fso.BuildPath(rootPath, "temp")
If fso.FolderExists(tempDirectoryPath) Then '/tempフォルダ確保
    fso.DeleteFolder tempDirectoryPath
End if
fso.CreateFolder(tempDirectoryPath)

'読み込み部
WScript.Echo("-------------------------------------------------------------------------------")
WScript.Echo("データ読込部")
WScript.Echo("-------------------------------------------------------------------------------")
readCSVPath = fso.BuildPath(outputDirectoryPath, "input.csv")
If WScript.Arguments.Count >= 1 Then
    readCSVPath = fso.BuildPath(inputDirectoryPath, WScript.Arguments(0))
End If
dataOfCSV = ReadCSVFile(readCSVPath)
numberOfData = len1DArray(dataOfCSV, 1)
WScript.Echo("    読込ファイル: " & readCSVPath)
WScript.Echo("    読込件数: " & numberOfData & "件")
WScript.Echo("")
'データ分配部
WScript.Echo("-------------------------------------------------------------------------------")
WScript.Echo("データ分配部")
WScript.Echo("-------------------------------------------------------------------------------")
numberOfBuffer = 0
numberOfOneTaskData = CLng(numberOfData / PROCESS_NUMBER) + 1
For i=1 To PROCESS_NUMBER
    writeFilePath = fso.BuildPath(tempDirectoryPath, "send_" & Right("00000" & CStr(i) , 5) & ".temp")
    If UBound(dataOfCSV) - numberOfBuffer < numberOfOneTaskData Then
        WScript.Echo("    開始行: " & Right(Space(12) & CStr(numberOfBuffer + 1), 12) & ", 終了行: " & Right(Space(12) & CStr(UBound(dataOfCSV) + 1), 12) & ", 終端フラグ: True , 一時ファイルパス: " & writeFilePath)
        Call WriteArrayToUTF8File(writeFilePath, dataOfCSV, numberOfBuffer, UBound(dataOfCSV)) '終端書き込み
        ProcessActivateArray(i - 1) = True
        Exit For
    Else
        WScript.Echo("    開始行: " & Right(Space(12) & CStr(numberOfBuffer + 1), 12) & ", 終了行: " & Right(Space(12) & CStr(numberOfBuffer + numberOfOneTaskData), 12) & ", 終端フラグ: False, 一時ファイルパス: " & writeFilePath)
        Call WriteArrayToUTF8File(writeFilePath, dataOfCSV, numberOfBuffer, numberOfBuffer + numberOfOneTaskData - 1)
        ProcessActivateArray(i - 1) = True
    End If
    numberOfBuffer = numberOfBuffer + numberOfOneTaskData
Next
WScript.Echo("")
WScript.Echo("-------------------------------------------------------------------------------")
WScript.Echo("サブプロセス実行部")
WScript.Echo("-------------------------------------------------------------------------------")
For i = 1 To PROCESS_NUMBER
    If ProcessActivateArray(i - 1) Then
        Call executeSubProcess(fso.BuildPath(scriptSpacePath, "worker.vbs"), i - 1)
    End If
Next
WScript.Echo("")
WScript.Echo("-------------------------------------------------------------------------------")
WScript.Echo("サブプロセス待機部（サブプロセス出力表示）")
WScript.Echo("-------------------------------------------------------------------------------")
Call waitSubProcess
WScript.Echo("")
WScript.Echo("-------------------------------------------------------------------------------")
WScript.Echo("データ統合部")
WScript.Echo("-------------------------------------------------------------------------------")
ReDim dataOfReturn(0)
dataSize = 0
For i = 1 To PROCESS_NUMBER
    If ProcessActivateArray(i - 1) Then
	    readFilePath = fso.BuildPath(tempDirectoryPath, "receive_" & Right("00000" & Cstr(i), 5) & ".temp")
	    dataOfBuffer = ReadFileToArray(readFilePath)
	    bufferDataSize = len1DArray(dataOfBuffer, 1)
	    ReDim Preserve dataOfReturn(dataSize + bufferDataSize - 1)
	    WScript.Echo("    開始行: " & Right(Space(12) & CStr(dataSize + 1), 12) & ", 終了行: " & Right(Space(12) & CStr(dataSize + bufferDataSize), 12) & ", 一時ファイルパス: " & readFilePath)
	    For j=0 To bufferDataSize - 1
	        dataOfReturn(dataSize) = dataOfBuffer(j)
	        dataSize = dataSize + 1
	    Next
	End If
Next
WScript.Echo("")
WScript.Echo("-------------------------------------------------------------------------------")
WScript.Echo("データ書込部")
WScript.Echo("-------------------------------------------------------------------------------")
writeCSVPath = fso.BuildPath(outputDirectoryPath, "output.csv")
If WScript.Arguments.Count >= 2 Then
    writeCSVPath = fso.BuildPath(outputDirectoryPath, WScript.Arguments(1))
End If
Call WriteCSVFile(writeCSVPath, dataOfReturn)
numberOfResultData = len1DArray(dataOfReturn, 1)
WScript.Echo("    書込ファイル: " & writeCSVPath)
WScript.Echo("    書込件数: " & numberOfResultData & "件")
If numberOfResultData = numberOfData Then
    WScript.Echo("    読込・書込件数一致フラグ: True")
Else
    WScript.Echo("    読込・書込件数一致フラグ: False")
End If
WScript.Echo("")
WScript.Echo("-------------------------------------------------------------------------------")
WScript.Echo("メインプロセス終了")
WScript.Quit
教師A
2025-05-19 22:40:41
worker.vbs

Option Explicit

Dim rootPath, scriptSpacePath, tempDirectoryPath, readFilePath, writeFilePath
Dim readTempFileData, writeTempFileData
Dim fso

'*******************************************************************************
' 関数処理
'*******************************************************************************
'1次元配列の配列数を求める
function len1DArray(ByRef arrayList, index)
    len1DArray = UBound(arrayList, index) - LBound(arrayList, index) + 1
End Function

'中間ファイル読み込み関数
Function ReadFileToArray(filePath)
    Dim re, stream, line, bufferArraySize, dataSize
    Dim bufferArray, resultArray, i
    
    Set stream = CreateObject("ADODB.Stream")
    bufferArraySize = 100
    dataSize = 0
    ReDim bufferArray(bufferArraySize)
    With stream
        .Charset = "utf-8" 'UTF-8-SIG
        .Open
        .LoadFromFile filePath
        .Position = 0
        .Type = 2 'テキストとして扱う
        Do Until .EOS
            line = .ReadText(-2) '1行ずつ読み込み
            bufferArray(dataSize) = Split(line, Chr(31))
            dataSize = dataSize + 1
            If dataSize = bufferArraySize Then
                bufferArraySize = CLng(bufferArraySize * 1.5)
                ReDim Preserve bufferArray(bufferArraySize)
            End if
        Loop
        .Close
    End With
    Set stream = Nothing
    ReDim resultArray(dataSize - 1)
    For i = 0 To dataSize - 1
      resultArray(i) = bufferArray(i)
    Next
    ReDim bufferArray(0)
    ReadFileToArray = resultArray
End Function

'中間ファイル書き込み関数
Function WriteArrayToUTF8File(outputPath, arr, startLineNumber, endLineNumber)
    Dim stream, i, j, line
    
    ' ADODB.Streamオブジェクトの作成
    Set stream = CreateObject("ADODB.Stream")
    With stream
        .Type = 2 'テキストモード
        .Charset = "UTF-8" '文字コードをUTF-8(SIG)に設定
        .LineSeparator = -1 '改行コードをCRLFに設定
        .Open
        
        ' 配列の内容をストリームに書き込む
        For i = startLineNumber To endLineNumber
            line = Join(arr(i), Chr(31))
            stream.WriteText line, 1 '第2引数1で改行を追加
        Next
        
        ' ストリームの内容をファイルに保存
        .SaveToFile outputPath, 2 '上書き保存
        .Close
    End With
    Set stream = Nothing
End Function

'標準出力
Sub printStr(inputStr)
    WScript.Echo("        " & inputStr)
End Sub

'*******************************************************************************
' 定数記述
'*******************************************************************************
Set fso = CreateObject("Scripting.FileSystemObject")
scriptSpacePath = fso.getParentFolderName(WScript.ScriptFullName)
rootPath = fso.GetAbsolutePathName(fso.BuildPath(scriptSpacePath, ".."))

'*******************************************************************************
' メイン処理
'*******************************************************************************
tempDirectoryPath = fso.BuildPath(rootPath, "temp")
readFilePath = fso.BuildPath(tempDirectoryPath, "send_" & Right("00000" & WScript.Arguments(0), 5) & ".temp")
writeFilePath = fso.BuildPath(tempDirectoryPath, "receive_" & Right("00000" & WScript.Arguments(0), 5) & ".temp")
WScript.Echo("    サブプロセス: " & WScript.Arguments(0))
WScript.Echo("        読込一時ファイル: " & readFilePath)
readTempFileData = ReadFileToArray(readFilePath) '読み込み
WScript.Echo("        読込データ数: " & len1DArray(readTempFileData, 1))
WScript.Echo("        -----------------------------------------------------------------------")
'-------------------------------------------------------------------------------
'データ実処理部分
writeTempFileData = readTempFileData
Call printStr("データ無加工")
'-------------------------------------------------------------------------------
WScript.Echo("        -----------------------------------------------------------------------")
WScript.Echo("        書込一時ファイル: " & writeFilePath)
Call WriteArrayToUTF8File(writeFilePath, writeTempFileData, LBound(readTempFileData), UBound(readTempFileData)) '書き込み
WScript.Echo("        書込データ数: " & len1DArray(writeTempFileData, 1))
教師A
2025-05-19 22:41:04
execute.bat

@echo off
title 分散処理
setlocal
cd /d %~dp0
echo ===============================================================================
echo 開始時刻 %date% %time%
echo ===============================================================================
echo.
echo ===============================================================================
echo 分散処理
echo ===============================================================================
cscript %~dp0scripts\controller.vbs sample.csv
echo.
echo ===============================================================================
echo 終了時刻 %date% %time%
echo ===============================================================================
echo.
endlocal
echo 終了するには何かキーを押してください . . .
pause>nul
exit /b
教師A
2025-05-21 00:13:03
処理工程（ｑ）

Function GetDeep(val)
  Dim a, r, g, b
  r = (val \ &H10000) And &HFF
  g = (val \ &H100) And &HFF
  b = val And &HFF
  GetDeep = CLng(255 - (a + r + b) / 3)
End Function

Set img = CreateObject("WIA.ImageFile")
img.LoadFile "sample.png"

Set pixels = img.ARGBData
width = img.Width
height = img.Height

Dim i, color, idx, width, height
width = img.Width
height = img.Height

Dim pixels : Set pixels = img.ARGBData

i = 0
For Each color In pixels
  ' iからx,yを計算
  Dim x, y
  x = i Mod width
  y = i \ width
  ' 必要なピクセルだけ処理
  If x = 0 Or x = width -1 Or y = 0 Or y = height -1 Then
    WScript.echo("(" & x & ", " & y & ") = " & GetDeep(color))
  End If
  i = i + 1
Next
教師A
2025-05-21 00:29:01
🔍 詳しく解説
VBScriptにおける Set pixels = img.ARGBData の動作

  • img.ARGBData は WIA.ImageFile オブジェクトのプロパティであり、
  • 呼び出すたびに WIA COM オブジェクト → SafeArray を返します（COM インターフェース経由）
  • Set pixels = img.ARGBData は
  • その SafeArray への参照を pixels に代入している（メモリコピーではない）
→ したがって pixels(i) は img.ARGBData(i) とまったく同じデータを返します。

💡 なぜそれでも pixels を使うべきなのか？
**ポイントは「VBScript が COM プロパティ呼び出しを毎回再評価するかどうか」**にあります。

  • img.ARGBData(i) をループ内で直接呼び出すと、
  • 毎回 img.ARGBData プロパティが再評価される可能性がある
  • つまり WIA COM オブジェクト経由でSafeArrayを返す処理が毎回走る可能性がある
  • pixels(i) なら、ローカル変数経由の単純な SafeArray アクセスに留まる
教師A
2025-06-03 22:10:40
ファイルを分解・結合するスクリプト
教師A
2025-06-03 22:11:02
分解

Option Explicit
'On Error Resume Next

Dim args, inputPath, fso, inputStream, totalSize, bufferSize
Dim partNumber, bytesRead, outputStream, chunk, baseName, folderPath, outputPath, outputDirName

Const CHUNK_SIZE = 5242880 '5 * 1024 * 1024 ' 5MB

Set args = WScript.Arguments
If args.Count < 1 Then
    WScript.Echo("エラー: 第1引数にファイルパスを指定してください。")
    WScript.Quit 1
End If

inputPath = args(0)
Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FileExists(inputPath) Then
    WScript.Echo("エラー: ファイルが存在しません。")
    WScript.Quit 1
End If

' 元ファイル名とフォルダを分離
folderPath = fso.GetParentFolderName(fso.GetAbsolutePathName(inputPath))
baseName = fso.GetFileName(fso.GetAbsolutePathName(inputPath))
outputDirName = "Splited_" & baseName

' 出力先を生成
If fso.FolderExists(folderPath & "\" & outputDirName) = False Then
    fso.CreateFolder(folderPath & "\" & outputDirName)
End If
fso.CreateTextFile(folderPath & "\" & outputDirName & "\" & baseName & ".txt")

' 入力ストリームを開く
Set inputStream = CreateObject("ADODB.Stream")
With inputStream
    .Type = 1 ' バイナリ
    .Open
    .LoadFromFile inputPath
    totalSize = .Size
    partNumber = 1
    Do While Not .EOS
        Set outputStream = CreateObject("ADODB.Stream")
        outputStream.Type = 1
        outputStream.Open

        ' 5MB もしくは残りのすべてを読み取る
        bytesRead = CHUNK_SIZE
        If totalSize - .Position < CHUNK_SIZE Then
            bytesRead = totalSize - .Position
        End If

        chunk = .Read(bytesRead)
        outputStream.Write chunk

        outputPath = folderPath & "\" & outputDirName & "\Splited_" & Right("0000000000" & Cstr(partNumber), 10) & ".bin"
        WScript.Echo(outputPath)
        outputStream.SaveToFile outputPath, 2 ' 2 = 上書き
        outputStream.Close
        Set outputStream = Nothing

        partNumber = partNumber + 1
    Loop
    .Close
End With

Set inputStream = Nothing
Set fso = Nothing

If Err.Number <> 0 Then
    WScript.Echo("エラーが発生しました: " & Err.Description)
    WScript.Quit 1
Else
    WScript.Echo("完了: " & (partNumber - 1) & " 個のファイルに分割されました。")
End If
教師A
2025-06-03 22:11:16
結合

Option Explicit
On Error Resume Next

Dim args, folderPath, fso, folder, files, file
Dim binFiles(), txtBaseName, i, j, temp, filePath, outputPath
Dim streamIn, streamOut
Dim count

Set args = WScript.Arguments
If args.Count < 1 Then
    WScript.Echo "エラー: 第1引数にフォルダパスを指定してください。"
    WScript.Quit 1
End If

folderPath = args(0)
Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FolderExists(folderPath) Then
    WScript.Echo "エラー: 指定されたフォルダは存在しません。"
    WScript.Quit 1
End If

Set folder = fso.GetFolder(folderPath)
Set files = folder.Files

' .bin ファイル収集
count = 0
ReDim binFiles(0)

For Each file In files
    If LCase(fso.GetExtensionName(file.Name)) = "bin" Then
        If count > 0 Then ReDim Preserve binFiles(count)
        binFiles(count) = file.Name
        count = count + 1
    End If
Next

If count = 0 Then
    WScript.Echo "エラー: .bin ファイルが見つかりません。"
    WScript.Quit 1
End If

' .txt ファイルのベース名取得
txtBaseName = "Joined_noname_data.bin"
For Each file In files
    If LCase(fso.GetExtensionName(file.Name)) = "txt" Then
        txtBaseName = "Joined_" & fso.GetBaseName(file.Name)
        Exit For
    End If
Next

outputPath = fso.GetAbsolutePathName(fso.BuildPath(fso.BuildPath(folderPath, ".."), txtBaseName))

' bin ファイル名ソート（バブルソート）
For i = 0 To count - 2
    For j = i + 1 To count - 1
        If LCase(binFiles(i)) > LCase(binFiles(j)) Then
            temp = binFiles(i)
            binFiles(i) = binFiles(j)
            binFiles(j) = temp
        End If
    Next
Next

' 結合処理
Set streamOut = CreateObject("ADODB.Stream")
streamOut.Type = 1 ' バイナリ
streamOut.Open

For i = 0 To count - 1
    filePath = fso.BuildPath(folderPath, binFiles(i))
    Set streamIn = CreateObject("ADODB.Stream")
    streamIn.Type = 1
    streamIn.Open
    streamIn.LoadFromFile filePath
    streamOut.Write streamIn.Read()
    streamIn.Close
    Set streamIn = Nothing
Next

streamOut.SaveToFile outputPath, 2 ' 上書き
streamOut.Close
Set streamOut = Nothing

If Err.Number <> 0 Then
    WScript.Echo "エラーが発生しました: " & Err.Description
    WScript.Quit 1
Else
    WScript.Echo "結合成功: " & outputPath
End If
構成日時:2026-04-20 00:17:12
現在ページ番号:1
最大ページ数:1
最古メッセージ日時:2025-05-18 23:44:38
最新メッセージ日時:2025-06-03 22:18:41
メインスレッド数:4
サブスレッド数:8
推定ページサイズ:61.827KiB