以前から何度も話題になっていましたが、なかなか しっくりこないので作成してみました。
皆様のトピックを参考にさせて頂いています。ありがとうございます。
以前トピックにあった程度のファイルサイズでのテスト結果は次の通りです。
・112KB 3186行で 0.8秒
・422KB 9600行で 3.4秒
(Pentium4 2.53GHz メモリ512MB WindowsXP Home でテスト)
不具合やお気づきの点がありましたら、ぜひ教えてください。
少し長くなりますがコードは次の通りです。
コード:
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'「LineInput #」 エミュレート ライブラリ RPLineInput.sbp by るっとパパ V1.00 06/11/18
'----------使用方法------------------------------------------------------------
'===準備===
'1. このファイルをプロジェクトフォルダに置く
'2. #include "RPLineInput.sbp" --- ライブラリの読込み(「TODO:」部分等に記述)
'===活用=== nは1~4、ファイル名,任意変数はString型
'3. ファイルオープン
' RPLIOpen(n,ファイル名) --- n :ファイル番号 1~4 (変数不可)
' ファイル名 :String型で指定
' (プロジェクトフォルダ外ならフルパスで)
'4. 一行読込み
' RPLineInput(n,任意変数) --- n :ファイル番号 1~4
' 任意変数:String型で指定(1行分が格納される)
' 戻り値 :0:ファイル終端 1:終端以外
'5. ファイルクローズ
' RPLIClose(n) --- n :ファイル番号 1~4
'----------注意事項------------------------------------------------------------
'1. 一度に扱えるファイル数は 4個までです。(下記 RPMaxFiles の値(変更可))
'2. 親ウィンドウのハンドルは hMainWnd になっています。
'3. エラー時はプログラムを終了するようになっています。
'4. ファイルをメモリに読込みますので、サイズによっては動作がおかしくなるかもしれません。
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Const RPMaxFiles = 4 '同時に扱えるファイル数
Dim RPFData(RPMaxFiles) As BytePtr 'ファイル格納用
Dim RPFSize(RPMaxFiles) As DWord 'ファイルサイズ
Dim RPFPointer(RPMaxFiles) As Long 'ファイルポインター
Dim RPLIOpenChk(RPMaxFiles) As Long '使用中のチェック
'■■■■■ RPLIOpen() ■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'ファイルオープン
Sub RPLIOpen(hID As Long,InFile As String)
Dim FilePath[MAX_PATH] As Byte
Dim hFile As HANDLE
Dim RBytes As Long
Dim RF As Long
'使用中のチェック
If RPLIOpenChk(hID)=1 Then
RPLIErr("RPLIOpen("+Str$(hID)+",*) 使用中!","RPLIOpen")
Exit Sub
End If
'ファイルオープン
lstrcpy(FilePath,InFile)
hFile=CreateFile(FilePath,GENERIC_READ,0,ByVal 0,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0)
If hFile=INVALID_HANDLE_VALUE Then
RPLIErr("RPLIOpen("+Str$(hID)+",*) オープン失敗!","RPLIOpen")
Exit Sub
End If
'入力ファイルの読込み
RPFSize(hID)=GetFileSize(hFile,NULL)
RPFData(hID)=HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,RPFSize(hID)+1)
RF =ReadFile(hFile,RPFData(hID),RPFSize(hID),VarPtr(RBytes),ByVal 0)
If RF=FALSE Then
CloseHandle(hFile)
HeapFree(GetProcessHeap(),0,RPFData(hID))
RPLIErr("RPLIOpen("+Str$(hID)+",*) 読込み失敗!","RPLIOpen")
Exit Sub
End If
CloseHandle(hFile)
'正常オープン処理
RPFPointer(hID) =1
RPLIOpenChk(hID)=1
End Sub
'■■■■■ RPLIClose()■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Sub RPLIClose(hID As Long)
'オープンしているかチェック
If RPLIOpenChk(hID)=0 Then
RPLIErr("RPLIOpen("+Str$(hID)+",*) していません!","RPLIClose")
Exit Sub
End If
'クローズ処理
HeapFree(GetProcessHeap(),0,RPFData(hID))
RPLIOpenChk(hID)=0
End Sub
'■■■■■ RPLineInput()■■■■■■■■■■■■■■■■■■■■■■■■■■■
Function RPLineInput(hID As Long,ByRef RPLine As String) As Long
Dim I As Long
Dim PT1 As Long
Dim PT2 As Long
Dim LineBuff As BytePtr
Dim c As Byte
Dim cn As Byte
'オープンしているかチェック
If RPLIOpenChk(hID)=0 Then
RPLIErr("RPLIOpen("+Str$(hID)+",*) していません!","RPLineInput")
Exit Sub
End If
'読込み処理
RPLineInput=0
PT1 =RPFPointer(hID)
PT2 =RPFSize(hID)
'----------------------------------
For I=PT1 To RPFSize(hID)
c =RPFData(hID)(I-1)
cn=RPFData(hID)(I)
If &h80<=c And c<=&h9f Then '()
I=I+1
ElseIf &he0<=c And c<=&hff Then '()
I=I+1
ElseIf c=&h0d And cn=&h0a Then 'c=CR & cn=LF
PT2 =I
RPFPointer(hID)=I+2
Exit For
ElseIf c=&h0a Then 'c=LF
PT2 =I
RPFPointer(hID)=I+1
Exit For
ElseIf c=&h00 Then 'c=00
PT2 =-1
RPFPointer(hID)=RPFSize(hID)
I=-1
Exit For
EndIf
Next I
'
If I>RPFSize(hID) Then
PT2 =I+1
RPFPointer(hID)=I
EndIf
'----------------------------------
If PT1>=RPFSize(hID) Then Exit Function
If PT2< 0 Then Exit Function
'1行読込み
RPLineInput=1
LineBuff=calloc(PT2-PT1+1)
memcpy(VarPtr(LineBuff(0)) As VoidPtr,(VarPtr(RPFData(hID)(0))+PT1-1) As VoidPtr,PT2-PT1)
RPLine=MakeStr(LineBuff)
End Function
'■■■■■ エラー処理■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Sub RPLIErr(ErrMsg1 As String,ErrMsg2 As String)
Dim I As Long
'メッセージの表示
MessageBox(hMainWnd,ErrMsg1+Ex"\r\n"+"終了します。",ErrMsg2,MB_OK+MB_SYSTEMMODAL)
'メモリ開放
For I=1 To RPMaxFiles
If RPLIOpenChk(I)=1 Then
HeapFree(GetProcessHeap(),0,RPFData(I))
RPLIOpenChk(I)=0
End If
Next I
'終了
SendMessage(hMainWnd,WM_CLOSE,0,0)
End Sub
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
下記ホームページでこのライブラリを使用した上記テストをしたプロジェクトを公開していますので お試しください。
http://homepage3.nifty.com/ruttopapa/
以前から何度も話題になっていましたが、なかなか しっくりこないので作成してみました。 皆様のトピックを参考にさせて頂いています。ありがとうございます。 以前トピックにあった程度のファイルサイズでのテスト結果は次の通りです。 ・112KB 3186行で 0.8秒 ・422KB 9600行で 3.4秒 (Pentium4 2.53GHz メモリ512MB WindowsXP Home でテスト)
不具合やお気づきの点がありましたら、ぜひ教えてください。 少し長くなりますがコードは次の通りです。 [code] '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ '「LineInput #」 エミュレート ライブラリ RPLineInput.sbp by るっとパパ V1.00 06/11/18 '----------使用方法------------------------------------------------------------ '===準備=== '1. このファイルをプロジェクトフォルダに置く '2. #include "RPLineInput.sbp" --- ライブラリの読込み(「TODO:」部分等に記述) '===活用=== nは1~4、ファイル名,任意変数はString型 '3. ファイルオープン ' RPLIOpen(n,ファイル名) --- n :ファイル番号 1~4 (変数不可) ' ファイル名 :String型で指定 ' (プロジェクトフォルダ外ならフルパスで) '4. 一行読込み ' RPLineInput(n,任意変数) --- n :ファイル番号 1~4 ' 任意変数:String型で指定(1行分が格納される) ' 戻り値 :0:ファイル終端 1:終端以外 '5. ファイルクローズ ' RPLIClose(n) --- n :ファイル番号 1~4 '----------注意事項------------------------------------------------------------ '1. 一度に扱えるファイル数は 4個までです。(下記 RPMaxFiles の値(変更可)) '2. 親ウィンドウのハンドルは hMainWnd になっています。 '3. エラー時はプログラムを終了するようになっています。 '4. ファイルをメモリに読込みますので、サイズによっては動作がおかしくなるかもしれません。 '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ Const RPMaxFiles = 4 '同時に扱えるファイル数 Dim RPFData(RPMaxFiles) As BytePtr 'ファイル格納用 Dim RPFSize(RPMaxFiles) As DWord 'ファイルサイズ Dim RPFPointer(RPMaxFiles) As Long 'ファイルポインター Dim RPLIOpenChk(RPMaxFiles) As Long '使用中のチェック '■■■■■ RPLIOpen() ■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 'ファイルオープン Sub RPLIOpen(hID As Long,InFile As String) Dim FilePath[MAX_PATH] As Byte Dim hFile As HANDLE Dim RBytes As Long Dim RF As Long '使用中のチェック If RPLIOpenChk(hID)=1 Then RPLIErr("RPLIOpen("+Str$(hID)+",*) 使用中!","RPLIOpen") Exit Sub End If 'ファイルオープン lstrcpy(FilePath,InFile) hFile=CreateFile(FilePath,GENERIC_READ,0,ByVal 0,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0) If hFile=INVALID_HANDLE_VALUE Then RPLIErr("RPLIOpen("+Str$(hID)+",*) オープン失敗!","RPLIOpen") Exit Sub End If '入力ファイルの読込み RPFSize(hID)=GetFileSize(hFile,NULL) RPFData(hID)=HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,RPFSize(hID)+1) RF =ReadFile(hFile,RPFData(hID),RPFSize(hID),VarPtr(RBytes),ByVal 0) If RF=FALSE Then CloseHandle(hFile) HeapFree(GetProcessHeap(),0,RPFData(hID)) RPLIErr("RPLIOpen("+Str$(hID)+",*) 読込み失敗!","RPLIOpen") Exit Sub End If CloseHandle(hFile) '正常オープン処理 RPFPointer(hID) =1 RPLIOpenChk(hID)=1 End Sub '■■■■■ RPLIClose()■■■■■■■■■■■■■■■■■■■■■■■■■■■■ Sub RPLIClose(hID As Long) 'オープンしているかチェック If RPLIOpenChk(hID)=0 Then RPLIErr("RPLIOpen("+Str$(hID)+",*) していません!","RPLIClose") Exit Sub End If 'クローズ処理 HeapFree(GetProcessHeap(),0,RPFData(hID)) RPLIOpenChk(hID)=0 End Sub '■■■■■ RPLineInput()■■■■■■■■■■■■■■■■■■■■■■■■■■■ Function RPLineInput(hID As Long,ByRef RPLine As String) As Long Dim I As Long Dim PT1 As Long Dim PT2 As Long Dim LineBuff As BytePtr Dim c As Byte Dim cn As Byte 'オープンしているかチェック If RPLIOpenChk(hID)=0 Then RPLIErr("RPLIOpen("+Str$(hID)+",*) していません!","RPLineInput") Exit Sub End If '読込み処理 RPLineInput=0 PT1 =RPFPointer(hID) PT2 =RPFSize(hID) '---------------------------------- For I=PT1 To RPFSize(hID) c =RPFData(hID)(I-1) cn=RPFData(hID)(I) If &h80<=c And c<=&h9f Then '() I=I+1 ElseIf &he0<=c And c<=&hff Then '() I=I+1 ElseIf c=&h0d And cn=&h0a Then 'c=CR & cn=LF PT2 =I RPFPointer(hID)=I+2 Exit For ElseIf c=&h0a Then 'c=LF PT2 =I RPFPointer(hID)=I+1 Exit For ElseIf c=&h00 Then 'c=00 PT2 =-1 RPFPointer(hID)=RPFSize(hID) I=-1 Exit For EndIf Next I ' If I>RPFSize(hID) Then PT2 =I+1 RPFPointer(hID)=I EndIf '---------------------------------- If PT1>=RPFSize(hID) Then Exit Function If PT2< 0 Then Exit Function '1行読込み RPLineInput=1 LineBuff=calloc(PT2-PT1+1) memcpy(VarPtr(LineBuff(0)) As VoidPtr,(VarPtr(RPFData(hID)(0))+PT1-1) As VoidPtr,PT2-PT1) RPLine=MakeStr(LineBuff) End Function '■■■■■ エラー処理■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ Sub RPLIErr(ErrMsg1 As String,ErrMsg2 As String) Dim I As Long 'メッセージの表示 MessageBox(hMainWnd,ErrMsg1+Ex"\r\n"+"終了します。",ErrMsg2,MB_OK+MB_SYSTEMMODAL) 'メモリ開放 For I=1 To RPMaxFiles If RPLIOpenChk(I)=1 Then HeapFree(GetProcessHeap(),0,RPFData(I)) RPLIOpenChk(I)=0 End If Next I '終了 SendMessage(hMainWnd,WM_CLOSE,0,0) End Sub '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ [/code] 下記ホームページでこのライブラリを使用した上記テストをしたプロジェクトを公開していますので お試しください。 [url]http://homepage3.nifty.com/ruttopapa/[/url]
|