ab.com コミュニティ https://www.activebasic.com/forum/ |
|
UTF-16LE版テキスト読み込みライブラリ https://www.activebasic.com/forum/viewtopic.php?t=1867 |
ページ 1 / 1 |
作成者: | THEREMIN [ 2007年3月19日(月) 06:06 ] |
記事の件名: | UTF-16LE版テキスト読み込みライブラリ |
Unicodeテキストを読み書きする必要性が生じたので、 るっとパパ様の 「LineInput #」 エミュレート ライブラリ RPLineInput.sbp を参考に、 UniCode版テキスト読み込みライブラリ <FileLineInputW.sbp>を作成してみました。 エラーチェックやエラーコード処理なども一応しています。 |
作成者: | THEREMIN [ 2007年3月19日(月) 06:23 ] |
記事の件名: | |
コード: '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ '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 |
作成者: | THEREMIN [ 2007年3月19日(月) 06:54 ] |
記事の件名: | |
型に統一性が無かったのと、るっとパパ様のRPLineInput.sbpと変数名がかぶっていたところがあったので修正しました。 なお、扱えるファイルサイズの上限は 扱う型をLong型にしたため、2,147,483,647Byte (2GB)までです。 (そんなに大きなファイルを扱うとは思えないけど…) |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |