ピクチャボックス, PaintPicture 内 LoadPicture関数の使い方

For IA& = Picture02.LBound To Picture02.UBound
Picture02(IA&).AutoRedraw = True
Picture02(IA&).AutoSize = False
Picture02(IA&).ScaleMode = vbPixels
Picture02(IA&).Cls
Next IA&
でSub Form_Load()にて初期化したあとで

IC& = Index
Picture02(IC&).ScaleMode = vbPixels
Picture02(IC&).PaintPicture LoadPicture(InFile$), 0, 0, YokoHaba&, TateTakasa&
Picture02(IC&).Refresh
と読み取ったときに
EOIセグメントが存在しないJPGファイルをInFile$に指定したのときにPicture02(IC&).PaintPictureでハング(CPU=100%, 無応答)します。
ハングアップの検出方法、又はハングアップしない参照方法などの対応をご存知の方いらっしゃいませんか。
Open InFile$ -Close でEOIセグメントの存在をチェックするとわずか50KBのファイルに約１秒(GW-Basic, 80286並の速度)使ってしまいます。より高速な方法を探しています。

OS Win2000 SP2
Visual basic 6.0 SP5
「EOIセグメントが存在しないJPGファイル」はクライアントからサーバーへの送信途中で回線を物理的に切断することにより作成したものです。

No.1 ベストアンサー 回答者： KenKen_SP 回答日時： 2006/11/16 02:41

こんにちは。

KenKen_SP です。

ハングアップの検出方法...これは知りません。で、もう片方の EOI セグメント。
これは Jpeg の End Of Image マーカのことですね？

> Open InFile$ -Close でEOIセグメントの存在をチェックするとわずか50KBの
> ファイルに約１秒(GW-Basic, 80286並の速度)使ってしまいます。

バイナリのヘッダ(SOIマーカ)とフッタ(EOIマーカ)だけ見た簡易チェッカーでは
ダメですかね...。これなら VB 標準のファイル I/O で約 700 KBの JPEG でも
計測不能な瞬時で判定できますけど。

(CPU: P4-2.4GHz Mem:512M WinXP VB6.0 or VBA)

適当に書いたコードですけど、参考になりますか？

' // テスト用時間計測 API
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

' // テストプロシージャ
Sub TestProc()
　　Dim lRet As Long
　　Dim sMsg As String
　　Dim t　　As Long
　　t = timeGetTime()
　　lRet = JpegChecker("C:\sample.jpg")
　　t = (timeGetTime() - t) / 1000
　　Select Case lRet
　　　　Case -1: sMsg = "ファイルオープンエラー"
　　　　Case 0:　sMsg = "Jpeg ではない（破損含む)"
　　　　Case 1:　sMsg = "Jpeg だと思う"
　　End Select
　　Debug.Print "Time:= " & Format$(t, "#,###.000sec")
　　Debug.Print "Result:= " & sMsg
End Sub

' // 簡易 Jpeg チェッカー
Private Function JpegChecker(ByVal FilePath As String) As Long

　　' 戻り値　1：Jpeg らしい 0：Jpeg ではない -1：ファイルが開けない
　　
　　Const JPEG_FILEHEADER As String = "FFD8"
　　Const JPEG_FILEFOOTER As String = "FFD9"

　　Dim Buf()　As Byte
　　Dim n　　　As Integer
　　Dim i　　　As Long
　　JpegChecker = -1
　　If Dir$(FilePath) <> "" Then
　　　　n = FreeFile()
　　　　On Error GoTo ERROR_HANDLER
　　　　Open FilePath For Binary Access Read As #n
　　　　　　ReDim Buf(LOF(n) - 1)
　　　　　　Get #n, , Buf
　　　　Close #n
　　　　On Error GoTo 0
　　　　i = UBound(Buf) - 1
　　　　' Check Jpeg SOI Marker And EOI Marker
　　　　If HexDump(Buf, 0, 2) = JPEG_FILEHEADER And _
　　　　　 HexDump(Buf, i, 2) = JPEG_FILEFOOTER Then
　　　　　 JpegChecker = 1
　　　　Else
　　　　　 JpegChecker = 0
　　　　End If
　　　　Erase Buf
　　End If
　　Exit Function
ERROR_HANDLER:
　　Err.Clear
　　Close #n
End Function

' // 16進ダンプ
Private Function HexDump( _
　　ByRef Buf() As Byte, _
　　ByVal Pos As Long, _
　　ByVal Length As Long, _
　　Optional ByVal LitteleEdian As Boolean = True _
) As String

　　Dim i　　As Long
　　Dim sTmp As String
　　Dim sRet As String
　　For i = Pos To Pos + Length - 1
　　　　sRet = sRet & Right$("0" & Hex$(Buf(i)), 2)
　　Next
　　If LitteleEdian Then
　　　　HexDump = sRet
　　Else
　　　　For i = 1 To Len(sRet) Step 2
　　　　　　sTmp = sTmp & Right$(sRet, 2)
　　　　　　sRet = Left(sRet, Len(sRet) - 2)
　　　　Next i
　　　　HexDump = sTmp
　　End If
End Function

この回答へのお礼

＞これは Jpeg の End Of Image マーカのことですね？
ご指摘のとおりです。

＞計測不能な瞬時で判定できますけど
ここでは規約上お知らせできないサイトの画像ファイル1268個, 内JPGファイルが1231個, 合計163MBの検査(ファイルアクセスを測定目的としていないので数回実行しファイルキャッシュが有効になった時点での測定値)では1231個を１３秒で終了しました(timeGetTimeの使い方がわからないのでNowシステム変数を使用)。
ペンテ4, 1.4Ghz, 2GB, Win2000

内3ファイルが「End Of Image マーカ」の後に2-1200byteの保存があり(JpegAnalyzer, http://www.vector.co.jp/soft/win95/art/se257653. …障害となりました。
よって、「ヘッダとフッタだけを見て」障害と判断したファイルに限って、全部の内容を見る
あるいは
内部メモリー実装状況をみて(現在方法を知りません)メモリーが十分存在する場合に限って使用する
という方法をとることにより十分対応が可能です。

十分参考になりました。

お礼日時：2006/11/21 23:55

No.2 回答者： KenKen_SP 回答日時： 2006/11/22 12:02

> End Of Image マーカ」の後に2-1200byte

あまり詳しくはないのですが、確かデジカメの画像（Exif）には EOI マーカ
が２つ存在する場合があった気がします。埋め込みサムネイル部の EOI マーカ
だったかな？

データのダウンロード途中で通信が切れるなどが原因で、1つめの EOI マーカ
以降が単に尻切れしているだけだと思います。

これはこれで、破損データで間違いないですよね？

Exif 以外の JPEGも含めて、正常であればファイル終端に必ず EOI マーカが
あるはずです。

仮に EOI 以降データがあったとしても、それはごく稀なイレギュラーなケース
として「破損ファイル」と断定しても問題ないと思いますが...

> 内部メモリー実装状況
ご参考までに。

Option Explicit

Public Type MEMORYSTATUS
　　dwLength　　　　As Long
　　dwMemoryLoad　　As Long
　　dwTotalPhys　　 As Long
　　dwAvailPhys　　 As Long
　　dwTotalPageFile As Long
　　dwAvailPageFile As Long
　　dwTotalVirtual　As Long
　　dwAvailVirtual　As Long
End Type
Public Enum STATUSTYPE
　　MemoryLoad　　' 使用中のメモリ（単位：%)
　　TotalPhys　　 ' トータル物理メモリサイズ(単位：Byte)
　　AvailPhys　　 ' 使用可能な物理メモリサイズ(単位：Byte)
　　TotalPageFile ' トータルページファイルサイズ(単位：Byte)
　　AvailPageFile ' 使用可能なページファイルサイズ(単位：Byte)
　　TotalVirtual　' トータル仮想メモリサイズ(単位：Byte)
　　AvailVirtual　' 使用可能な仮想メモリサイズ(単位：Byte)
End Enum
Private Declare Sub GlobalMemoryStatus Lib "kernel32" ( _
　　ByRef lpBuffer As MEMORYSTATUS _
)

' // メモリの状態を取得
Public Function GetGlobalMemoryInfo( _
　　ByVal Status As STATUSTYPE _
) As Long
　　Dim uMemory As MEMORYSTATUS
　　Dim lRet　　As Long
　　lRet = -1 ' Error Value
　　Call GlobalMemoryStatus(uMemory)
　　Select Case Status
　　　　Case MemoryLoad:　　lRet = uMemory.dwMemoryLoad
　　　　Case TotalPhys:　　 lRet = uMemory.dwTotalPhys
　　　　Case AvailPhys:　　 lRet = uMemory.dwAvailPhys
　　　　Case TotalPageFile: lRet = uMemory.dwTotalPageFile
　　　　Case AvailPageFile: lRet = uMemory.dwAvailPageFile
　　　　Case TotalVirtual:　lRet = uMemory.dwTotalVirtual
　　　　Case AvailVirtual:　lRet = uMemory.dwAvailVirtual
　　End Select
　　GetGlobalMemoryInfo = lRet
End Function

Sub test()
　　Dim lRet As Long
　　lRet = GetGlobalMemoryInfo(TotalPhys)
　　Debug.Print "物理メモリ：" & CStr(lRet / 1024 / 1024) & "MB"
　　lRet = GetGlobalMemoryInfo(AvailPhys)
　　Debug.Print "使用可能な物理メモリ：" & CStr(lRet / 1024 / 1024) & "MB"
End Sub

この回答への補足

＞２つ存在する場合があった気がします
探しましたが見つけることはできませんでした。成人向け漫画しか集めていませんのでそのためと思われます。実写は入手が面倒(ウイルス対策でJAVAを切断, そのため見られないサイトがほとんど, 中身を見てアドレスを調べて...は面倒)なので集めていません。

＞破損データで間違いないですよね？
確実に破損データです。サーバー自作を行っていてます。クライアント機からサーバー機へデータ転送中に発生する事故を想定して物理回線を切断して作成しましたから。
おかしなファイルは末尾に&H0d, &H0Aが入っている(PC-9801時代の画像処理ソフトではClose時に強制的に書きこまれるソフトがあります)場合でした。
あるいは, ゴミが入っている(256byte単位等でload-saveする関係)で, ＜img ＨＲＥＦ="....等が書きこまれていた場合でした。
まだPC-9801が動く(PC-9801用ソフトの移植が終わっていない, Win用ソフトを購入していない)のでしばらくは必要な機能です。
全部の機械を動員して一度に送信しすることで, 先頭が欠落しているJPGファイルなどの作成にも成功しました。

＞ご参考までに。
助かりました。

補足日時：2006/12/01 23:21