ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2024年3月29日(金) 04:07

全ての表示時間は UTC+09:00 です




返信する
ユーザー名:
件名:
メッセージ本文:
メッセージを入力してください。60000 字まで入力できます。 

フォントサイズ:
フォントカラー
オプション:
BBCode: ON
[img]: ON
[flash]: OFF
[url]: ON
スマイリー: OFF
BBCode を無効にする
URL を自動的にパースしない
クイズ
お手数ですがカタカナで「エービー」と4文字を入力してください。:
答えを正確に入力してください。答えられるかどうかでスパムボットか否かを判定します。
   

トピックのレビュー - UTF-16LE版テキスト読み込みライブラリ
作成者 メッセージ
  記事の件名:   引用付きで返信する
型に統一性が無かったのと、るっとパパ様のRPLineInput.sbpと変数名がかぶっていたところがあったので修正しました。

なお、扱えるファイルサイズの上限は
扱う型をLong型にしたため、2,147,483,647Byte (2GB)までです。
(そんなに大きなファイルを扱うとは思えないけど…)
投稿記事 Posted: 2007年3月19日(月) 06:54
  記事の件名:   引用付きで返信する
コード:
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'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
投稿記事 Posted: 2007年3月19日(月) 06:23
  記事の件名:  UTF-16LE版テキスト読み込みライブラリ  引用付きで返信する
Unicodeテキストを読み書きする必要性が生じたので、
るっとパパ様の 「LineInput #」 エミュレート ライブラリ RPLineInput.sbp を参考に、
UniCode版テキスト読み込みライブラリ <FileLineInputW.sbp>を作成してみました。
エラーチェックやエラーコード処理なども一応しています。
投稿記事 Posted: 2007年3月19日(月) 06:06

全ての表示時間は UTC+09:00 です


ページ移動:  
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by ocean