コード:
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'ORIGIN: 「LineInput #」 エミュレート ライブラリ RPLineInput.sbp by るっとパパ V1.00 06/11/18
'UniCode版テキスト読み込みライブラリ <FileLineInputW.sbp> By THEREMIN(仮) 07/03/18
'----------使用方法------------------------------------------------------------
' UTF-16LE BOM付きテキストを扱います。
' IDにはファイル番号(0~FWMaxFiles)を指定します。
':: ファイルを開く
' FileLIOpenW(ID,ファイル名[,ハンドル]) --- ファイル名 :String型で指定
' ハンドル :hFileLineInputWを参照
' 戻り値 :読み込んだバイト数(BOMを除く) [Long]
' エラー発生時: LOCKED_VALUE, OpenErr_VALUE, FAILED_VALUE, ReadErr_VALUE を返す
'
':: 一行読込み
' FileLineInputW(ID, バッファ) --- バッファ:*WCHAR型で指定
' 戻り値 :取得した文字数 [Long]
' :-1 (ファイル終端)
':: 区切りコードまで読込み
' FileInputToSepW(ID, バッファ, 区切りコード) --- バッファ:*WCHAR型で指定
' 区切りコード : WCHAR型で指定
' 戻り値 :取得した文字数 [Long]
' :-1 (ファイル終端)
':: 読み込んだファイルの行数を返す
' FileLineCountW(ID) --- 戻り値 :ファイルの行数 [Long]
'
':: ファイルを閉じる
' FileLICloseW(ID) --- ID :ファイル番号 0~4
' 戻り値 :ALLOK_VALUE, FAILED_VALUE [Char]
':: メッセージの親ウィンドウを変える
' FileLineInputW_ChageHWND(ハンドル)
'----------注意事項------------------------------------------------------------
'1. 一度に扱えるファイル数は FWMaxFiles+1個までです。
'2. 親ウィンドウのハンドルは 指定しない場合 hMainWnd になります。
'3. エラー発生時はプログラムを終了します。
' 深刻なエラーでなければ、何もせずに処理を返します。
'4. ファイルをメモリに読込みますので、サイズによっては動作がおかしくなるかもしれません。
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Const FWMaxFiles =4 '同時に扱えるファイル数
Const FirstIndex =1 'UnicodeのBOMを除いた最初のIndex
#ifndef __FILE_RETURN_VALUE
#define __FILE_RETURN_VALUE
Const ALLOK_VALUE = 1 ' 成功値
Const FAILED_VALUE = -1 ' 失敗値
Const INVALID_VALUE = 0 ' 添え字が範囲内に無い
Const LOCKED_VALUE = -5 ' 使用中エラー
Const ERROR_ACCESS_DENIED = &H5
#endif
Const ReadErr_VALUE = -2 ' 読込みエラー
Const OpenErr_VALUE = -3 ' オープンエラー
Const EOF = -1
Dim FWData(FWMaxFiles) As *WCHAR 'ファイル格納用
Dim FWSize(FWMaxFiles) As Long 'ファイルサイズ(2,147,483,647Byteまで)
Dim FWWords(FWMaxFiles) As Long 'ファイルの文字数(FWSize/2)
Dim FWPointer(FWMaxFiles) As Long 'ファイルポインタ
Dim FWOpenChk(FWMaxFiles) As BOOL '使用中のチェック
Dim rp As Integer
For rp=0 To FWMaxFiles
FWOpenChk(rp)=FALSE
Next
Dim hFileLineInputW As HWND ' メッセージを表示する時の親ウィンドウのハンドル
'■■■■■ FileLIOpenW(ID,ファイル名[,指定するハンドル]) ■■■■■■■■■■■■■■■■■
Function FileLIOpenW(hID As Integer, InFile As String)(hParent As HWND) As Long
' 添え字が範囲内かどうかチェック
If hID<=FWMaxFiles And hID>=0 Then
'使用中のチェック
If FWOpenChk(hID)<>FALSE Then
' FileLIErr("FileLIOpenW("+Str$(hID)+",*) 使用中!","FileLIOpenW")
FileLIOpenW = LOCKED_VALUE
Exit Function
End If
If hParent<>NULL Then
hFileLineInputW = hParent ' メッセージの親ウィンドウハンドルを設定
Else
hFileLineInputW = hMainWnd ' 指定されない場合はメインウィンドウのハンドル
End If
Dim FilePath[MAX_PATH] As Byte
Dim hFile As HANDLE
Dim RBytes As Long
Dim RF As Long
/* ファイルを開く */
lstrcpy(FilePath,InFile)
hFile=CreateFile(FilePath,GENERIC_READ,0,ByVal 0,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0)
If hFile=INVALID_HANDLE_VALUE Then
' FileLIErr("FileLIOpenW("+Str$(hID)+",*) オープン失敗!","FileLIOpenW")
FileLIOpenW = OpenErr_VALUE
Exit Function
End If
/* ファイルサイズの読込み */
FWSize(hID)=GetFileSize(hFile,NULL) As Long
If FWSize(hID)=&HFFFFFFFF Then
FileLIErr("FileLIOpenW("+Str$(hID)+",*) ファイルサイズの取得に失敗!","FileLIOpenW")
FileLIOpenW = FAILED_VALUE
Exit Function
End If
FWWords(hID)=FWSize(hID)>>1 ' サイズから文字数に変換
/* メモリの確保 */
FWData(hID)=HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,FWSize(hID)+1)
If FWData(hID)=0 Then
' FileLIErr("FileLIOpenW("+Str$(hID)+",*) メモリの確保に失敗!","FileLIOpenW")
FileLIOpenW = FAILED_VALUE
Exit Function
End If
/* ファイルの読み込み */
RF =ReadFile(hFile,FWData(hID),FWSize(hID) As DWord,VarPtr(RBytes),ByVal 0)
CloseHandle(hFile)
If RF=FALSE Then
HeapFree(GetProcessHeap(),0,FWData(hID))
' FileLIErr("FileLIOpenW("+Str$(hID)+",*) 読込みに失敗!","FileLIOpenW")
FileLIOpenW = ReadErr_VALUE
Exit Function
End If
'正常オープン処理
FWPointer(hID) = FirstIndex ' UnicodeのBOM分進める
FWOpenChk(hID)= TRUE
FileLIOpenW = FWSize(hID)-2 ' BOMの分を引く
Else
FileLIErr("FileLIOpenW("+Str$(hID)+",*) 添え字が不正!","FileLIOpenW")
Exit Function
End If
End Function
'■■■■■ FileLICloseW(ID)■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Function FileLICloseW(hID As Integer) As Char
If hID<=FWMaxFiles And hID>=0 Then
'オープンチェック
If FWOpenChk(hID)=FALSE Then
' FileLIErr("FileLIOpenW("+Str$(hID)+",*) していません!","FileLICloseW")
FileLICloseW = FAILED_VALUE
Exit Function
End If
'クローズ処理
HeapFree(GetProcessHeap(),0,FWData(hID))
FWOpenChk(hID)=FALSE
FileLICloseW = ALLOK_VALUE ' 正常終了フラグ
Else
FileLIErr("FileLICloseW("+Str$(hID)+") 添え字が不正!","FileLICloseW")
Exit Function
End If
End Function
'■■■■■ FileLineCountW(ID)■■■■■■■■■■■■■■■■■■■■■■■■■■
Function FileLineCountW(hID As Integer) As Long
If hID<=FWMaxFiles And hID>=0 Then
'オープンチェック
If FWOpenChk(hID)=FALSE Then
FileLIErr("FileLIOpenW("+Str$(hID)+",*) していません!","FileLineCountW")
Exit Function
End If
'行のカウント
'----------------------------------
Dim I As Long
Dim cbuf As WCHAR
Dim Lines=1 As Long '2147483647行までカウント可
For I=FirstIndex To FWWords(hID)-1
cbuf =FWData(hID)(I)
If cbuf=&h0d or cbuf=&h0a Then 'CR + LF
Lines++
I++
EndIf
Next I
FileLineCountW = Lines
Else
FileLIErr("FileLineCountW("+Str$(hID)+") 添え字が不正!","FileLineCountW")
Exit Function
End If
End Function
'■■■■■ FileLineInputW(ID,格納するバッファ,)■■■■■■■■■■■■■■■■■■■
Function FileLineInputW(hID As Integer, ByRef RPLine As *WCHAR) As Long
FileLineInputW = FileInputTo2SepW(hID, RPLine, &h0d, &h0a, "FileLineInputW")
End Function
'■■■■■ FileInputToSepW(ID,格納するバッファ,区切りコード)■■■■■■■■■■■■
Function FileInputToSepW(hID As Integer, ByRef RPLine As *WCHAR, wsep As WCHAR) As Long
FileInputToSepW = FileInputTo2SepW(hID, RPLine, wsep, wsep, "FileInputToSepW")
End Function
'〓〓〓 内部から呼び出す関数 〓〓〓
'■■■■■ FileInputTo2SepW(ID,区切りコード1,区切りコード2,呼び出した関数名)■■■■
Function FileInputTo2SepW(hID As Integer,ByRef RPLine As *WCHAR,wsep1 As WCHAR,wsep2 As WCHAR,f_name As String) As Long
If hID<=FWMaxFiles And hID>=0 Then
'オープンチェック
If FWOpenChk(hID)=FALSE Then
FileLIErr("FileLIOpenW("+Str$(hID)+",*) していません!",f_name)
Exit Function
End If
Dim PT1 As Long '先頭アドレス
Dim PT2 As Long '終端アドレス
Dim cbuf As WCHAR
PT1 =FWPointer(hID)
PT2 =FWWords(hID)
If PT1>=PT2 Then ' ファイル終端まで到達したとき
FWPointer(hID) = FirstIndex
FileInputTo2SepW = EOF ' -1を返す
Exit Function
End If
'読込み処理
'----------------------------------
Dim I As Long
For I=PT1 To FWWords(hID)-1
cbuf =FWData(hID)(I)
If cbuf=wsep1 or cbuf=wsep2 Then 'CR または LF
PT2 =I
I++
If FWData(hID)(I)=wsep2 Then I++ 'CRの後にLFが無かった場合も考慮
FWPointer(hID)=I
Exit For
EndIf
Next I
If I>=FWWords(hID) Then ' ファイル終端まで到達したとき
FWPointer(hID)=I
EndIf
'----------------------------------
'一行読込み
Dim LineBuff As *WCHAR
Dim plen As Long
plen = PT2-PT1
FileInputTo2SepW =plen ' 読み込んだ文字数
plen *= 2
LineBuff =calloc(plen+2)
memcpy(VarPtr(LineBuff[0]),VarPtr(FWData[hID][PT1]), plen As DWord)
RPLine = LineBuff ' 一行返す
Else
FileLIErr(f_name+"("+Str$(hID)+",*) 添え字が不正!",f_name)
Exit Function
End If
End Function
'■■■■■ エラー処理■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Sub FileLIErr(ErrMsg1 As String,ErrMsg2 As String)
'メッセージの表示
MessageBox(hFileLineInputW,ErrMsg1+Ex"\r\n"+"終了します。",ErrMsg2,MB_OK+MB_SYSTEMMODAL)
'メモリ開放
Dim I As Integer
For I=1 To FWMaxFiles
If FWOpenChk(I)=TRUE Then
HeapFree(GetProcessHeap(),0,FWData(I))
FWOpenChk(I) =FALSE
End If
Next I
'終了
SendMessage(hFileLineInputW,WM_CLOSE,0,0)
End Sub
'〓〓〓 〓〓〓〓〓〓〓〓〓〓 〓〓〓
'■■■■■ メッセージの親ウィンドウを変えたいとき■■■■■■■■■■■■■■■
Sub FileLineInputW_ChageHWND(hID As Word, hWnd As HWND)
hFileLineInputW = hWnd
End Sub