プログラミング初めに
※ 本記事は、ExcelマクロでCOBOLソースを自動編集させるマクロを作る記事の第４話です。
メインロジック
今回は、OrthographyEditモジュールです。
このモジュール内のSourceEditメソッドを実行することで、ソース編集を実行します。
Option Explicit
'表示用に使用するエディタを定義する。 既定値はメモ帳
'Private Const COB_EDITER As String = "notepad "
Private Const COB_EDITER As String = "D:\Program Files\Yokka\DeuxEditor\DeuxEditor.exe "
'ファイルシステムオブジェクト
Private Const ForReading As Integer = 1 '読み取り専用でファイルを開きます。このファイルに書き込むことはできません。
Private Const ForAppending As Integer = 8 'ファイルを開き、ファイルの末尾から書き込みます。
Private Const TristateUseDefault As Double = -2 'システムの既定値を使ってファイルを開きます。
Private Const TristateTrue As Double = -1 'Unicode としてファイルを開きます。
Private Const TristateFalse As Double = 0 'ASCII ファイルとしてファイルを開きます。
' 機能 : COBOLソース編集
'
' 機能説明 : COBOLソースファイルを読み込んで自動編集します。
' : 1. 一連番号領域の番号を更新する
' : 2. 右側空白を除去する
' : 3. 空白行があった場合コメント行とする
'
Public Sub SourceEdit()
'-----------
' 変数宣言
'-----------
'FileSystemObject
Dim fso As Object '
Dim myInFile As Object 'ソースファイル
Dim myOutFile As Object '出力ファイル
'ファイル情報
Dim myFolder As String
Dim myFile As String
Dim myPath '編集対象Sourceパス
'ソースコード
Dim myWorkStr As String '読み込みテキスト行
Dim myWriteStr As String '書き込みテキスト
'編集用
Dim myNo As String '連番
Dim myByte As Integer '行のバイト数
Dim myNoDom As String '一連番号領域
Dim myABDom As String 'cobolｿｰｽＡ領域・Ｂ領域
Dim mySqlComNum As Integer 'SQL文中のコメント開始位置
'フラグ
Dim myNoSpaceFlg As Boolean '一連番号領域フラグ（true：空白にする、false：連番で上書きする）
Dim myExecSql As Boolean 'EXEC SQL 文中の処理か判断フラグ（True：SQL中, False：SQL中でない）
'Shell関数の戻値
Dim myRetVal As Variant
'------------
' 初期処理
'------------
'フラグのクリア
myExecSql = False 'SQL中フラグ
'一連番号領域の扱い選択
Select Case MsgBox("一連番号領域の扱いはどうしますか？" & Chr(10) & Chr(10) & _
" 空白 ： はい" & Chr(10) & _
" 連番 ： いいえ" _
, vbYesNoCancel)
Case vbYes: myNoSpaceFlg = True
Case vbNo: myNoSpaceFlg = False
Case vbCancel: Exit Sub
Case Else:
MsgBox "一連番号領域の扱い選択のシステムエラー"
Exit Sub
End Select
'ＣＯＢＯＬソースの選択
myPath = Application.GetOpenFilename("ＣＯＢＯＬソース(*.cob;*.pco;*.CBL),*.cob;*.pco;*.CBL", , "ＣＯＢＯＬソース選択")
If myPath = False Then
Exit Sub
End If
'--------------
' ファイル生成
'--------------
'ファイル生成用のオブジェクト作成
Set fso = CreateObject("Scripting.FileSystemObject")
'cobolｿｰｽのopen
Set myInFile = fso.OpenTextFile(myPath, ForReading, True, TristateFalse)
'tmpの作成
myFolder = fso.GetSpecialFolder(2)
myFile = fso.GetTempName
fso.CreateTextFile (myFolder & "\" & myFile)
Set myOutFile = fso.OpenTextFile(myFolder & "\" & myFile, ForAppending, False, TristateFalse)
'--------------
' 編集開始
'--------------
'cobolｿｰｽの編集
Do While myInFile.AtEndOfStream <> True
'１行読み込みます。
myWorkStr = myInFile.ReadLine
'実体のない行は、無視します。
If Trim(myWorkStr) <> "" Then
'右側空白の除去
myWriteStr = RTrim(myWorkStr)
'一連番号領域の更新
myByte = K_LenByte(myWriteStr)
'Byte数が6以上の場合
If myByte >= 6 Then
'-------------
' 領域情報取得
'-------------
'一連番号領域を取得
myNoDom = K_midByte(myWorkStr, 1, 6)
'ＡＢ領域を取得
myABDom = K_midByte(myWorkStr, 7, myByte - 6)
'標識領域に全角文字がある時は、ＡＢ領域を1Byte右にシフトする
If K_LenByte(K_midByte(myWorkStr, 7, 1)) = 2 Then
myABDom = " " & myABDom
Debug.Print "行№ - " & myInFile.Line - 1 & " 「異常」標識領域にまたがる形で全角文字があります（警告）"
End If
'標識領域に全角文字がある場合は空白に置き換える
If K_LenByte(myNoDom) <> 6 Then
Debug.Print "行№ - " & myInFile.Line - 1 & " 「異常」標識領域にまたがる形で全角文字があります"
myNoDom = ""
End If
'------------
' SQL文編集
'------------
'SQL使用の判断
If myExecSql = False Then
myExecSql = ExecSqlStartChk(myNoDom & myABDom)
End If
'SQL文中の場合、単一行コメント判定
If myExecSql = True Then
'単一行コメントが存在する
mySqlComNum = InStr(1, myABDom, "*>")
If mySqlComNum > 0 Then
'単一行コメントの位置が74Byte以降の場合
If mySqlComNum > 74 Then
'コメントの位置を、75Byteから始まるように調整する
myABDom = Left(myABDom, 74) & Right(myABDom, Len(myABDom) - mySqlComNum + 1)
'単一行コメントが74Byte以前の場合
Else
'コメントの位置を、75Byteから始まるように調整する
myABDom = Left(myABDom, mySqlComNum - 1) & _
String(74 - (mySqlComNum - 1), " ") & _
Right(myABDom, Len(myABDom) - mySqlComNum + 1)
End If
End If
End If
'SQL使用終了の判断
If myExecSql = True Then
If ExecSqlEndChk(myNoDom & myABDom) = True Then
myExecSql = False
End If
End If
'--------------
' ファイル出力
'--------------
'一連番号領域が数値のみ、又は空白の場合
If IsNumeric(myNoDom) Or Trim(myNoDom) = "" Then
'通常出力
If myABDom = "" Then
myWriteStr = cobolNoAdd(myNo, myNoSpaceFlg) & "*"
Else
myWriteStr = cobolNoAdd(myNo, myNoSpaceFlg) & myABDom
End If
myOutFile.WriteLine myWriteStr
'一連番号領域に数値、空白以外の文字がある場合
Else
'一連番号領域の現在値を強制的に上書きします。
Debug.Print "行№ - " & myInFile.Line - 1 & " 「警告」一連番号領域に不正文字【" & myNoDom & "】 領域番号を上書きしました"
myWriteStr = cobolNoAdd(myNo, myNoSpaceFlg) & myABDom
myOutFile.WriteLine myWriteStr
End If
'5byte以下の場合、強制的にコメント行にする
Else
'一連番号領域の現在値を強制的に上書きします。
Debug.Print "行№ - " & myInFile.Line - 1 & " 「警告」一連番号領域に不正文字【" & myWorkStr & "】 領域番号を上書きしました"
myWriteStr = cobolNoAdd(myNo, myNoSpaceFlg) & "*"
myOutFile.WriteLine myWriteStr
End If
End If
Loop
'----------
'終了処理
'----------
normalEnd:
'編集した結果でオリジナルを上書きします。
fso.CopyFile myFolder & "\" & myFile, myPath, True
'編集したソースを表示します。
myRetVal = Shell(COB_EDITER & myPath, vbNormalFocus)
'入出力ファイルを閉じる
myInFile.Close '入力ファイル
myOutFile.Close '出力ファイル
'出力ファイルを削除する
fso.DeleteFile (myFolder & "\" & myFile)
'FileSystemObjectの開放
Set fso = Nothing
Set myInFile = Nothing
Set myOutFile = Nothing
Exit Sub
End Sub
ファイルシステムオブジェクトを使用して、選択されたテキストファイル（COBOLソースファイル）に対して編集を行います。
編集内容については、第１話で記述した内容です。
編集といっても、直接ファイルを編集するのではなくて、ソース編集用のワークファイルを作成して、最後に元のファイルを上書きするという手順を使っています。
編集後、対象ファイルをテキストエディタでOPENします。
このとき使用するエディタは、Public変数「COB_EDITER」で指定します。
欠点があるとすれば、この処理を通す前のオリジナルのソースが残らないってことですかね。
まぁ、その手の管理は資産管理ソフトで行うものと割り切っています。
第１話（概要）： NetCOBOLのソース編集をExcelマクロで作ってみた（概要）
第２話（共通関数）： NetCOBOLのソース編集をExcelマクロで作ってみた（共通関数）
第３話（専用関数）： NetCOBOLのソース編集をExcelマクロで作ってみた（専用関数）
第４話（Cobolソース編集） ： この記事です
第５話（実行結果） ： NetCOBOLのソース編集をExcelマクロで作ってみた（実行結果）
投稿記事の一覧：目次
次回
次回は、完成したマクロを動かして見ます。
スポンサードリンク
0
0
