LoadPicture载入图片的问题

[zyyou]

最近写了一个程序，要大量接收来自客户上传的图片，客户先上传到服务器，我在从服务器中下载，然后加载到Picture中，可能是客户上传的问题，有时会出现图片损坏的情况，一但我这里收到损坏的图片，程序就会死掉。

现在想在载入前判断，但是结果一样，判断时就死了

谁有好的方法判断图片是否有效，谢谢

Private Sub Command1_Click()
    Dim Pic As Picture
    Set Pic = LoadPicture(App.Path & "\正常图片.jpg")
    Picture1.Picture = Pic
End Sub
Private Sub Command2_Click()
    Dim Pic As Picture
    On Error Resume Next
    Set Pic = LoadPicture(App.Path & "\有问题的图片.jpg")
    Picture1.Picture = Pic
End Sub
Private Sub Command3_Click()
    MsgBox PicEffective(App.Path & "\有问题的图片.jpg")
End Sub
Private Function PicEffective(FileName As String) As Boolean
    Dim Pic As StdPicture
    On Error GoTo er
    
    PicEffective = True
    Set Pic = LoadPicture(FileName)
    Set Pic = Nothing
    Exit Function
er:
    PicEffective = False
End Function

[dbcontrols]

用#2楼的方法找出有问题的图片，然后把图片的物理地址记录到一个文本文件里，以便于下一步出来。
或者发现有问题的图片，记录物理位置后直接删除
具体你想做什么是你的事，另外，找张损坏了的图片，让它出错，然后看一下错误号，要根据错误号判断是不是这种错误，用if Err.Number=xxx then决定下一步怎么应对

[zyyou]

[Quote=引用 4 楼 dbcontrols 的回复:]
用#2楼的方法找出有问题的图片，然后把图片的物理地址记录到一个文本文件里，以便于下一步出来。
或者发现有问题的图片，记录物理位置后直接删除
具体你想做什么是你的事，另外，找张损坏了的图片，让它出错，然后看一下错误号，要根据错误号判断是不是这种错误，用if Err.Number=xxx then决定下一步怎么应对
[/Quote]
只要一使用LoadPicture加载有问题的图片，vb直接死掉，还轮不到后面的步骤

[dbcontrols]

“只要一使用LoadPicture加载有问题的图片，vb直接死掉”这就需要在加载前检查文件是否完整了

[soarsoar77]

看图片的大小，一般用相同的截取办法得到的图片大小都一样的

如果图片损坏的话，大小就不一样了

[cbm6666]

Private Sub Command1_Click()
On Error GoTo Errh
Picture1.Picture = LoadPicture("c:\setup.jpg")
Errh:
If Err > 0 Then MsgBox "无效图片"
End Sub

[zyyou]

[Quote=引用 1 楼 soarsoar77 的回复:]
看图片的大小，一般用相同的截取办法得到的图片大小都一样的

如果图片损坏的话，大小就不一样了
[/Quote]
大小不一样

[soarsoar77]

这个更深入一点，就是看你的图片是bmp还是JPG，根据不同的图片格式，读取图片的前几个字符判断下是否符合图片格式要求

[zyyou]

应该是系统的问题,出问题的系统是2003,xp正常

[赵4老师]

先尝试独占打开图片文件，如果失败，表示图片文件还没上传完。具体请参考下面：

Private Sub Command1_Click()'找出文件夹内文件最新的更新时间(包括里面的子文件夹的文件哈) 要把这个文件夹内的所有文件的最后修改时间都要检查一次,并取出近的一个时间,(主要是检查这个文件夹里面的内容有没有更新),并取出这个文件最后一次的更新时间.环境是VB6
Dim after As Double
Dim f As Integer
Dim dn As String
Dim fn As String
Dim ft As String
Dim ft_date As Date
Command1.Enabled = False

On Error GoTo ERR0
Kill "c:\files.txt"

dn = "c:\windows"
On Error GoTo ERR1
Shell ("cmd /c dir " & dn & "\*.* /a-d /b /s /o-d >c:\files.txt")
after = Now + 60# / 3600# / 24#
f = FreeFile()
Do
REOPEN1:
    DoEvents
    If Now > after Then
        MsgBox "Wait c:\files.txt 60s overtime!"
        Exit Sub
    End If
    Open "c:\files.txt" For Input Lock Read Write As #f
    Line Input #f, fn
    Close #f
    Exit Do
Loop

On Error GoTo ERR0
Kill "c:\files.txt"

On Error GoTo ERR2
Shell ("cmd /c dir " & Chr(34) & fn & Chr(34) & ">c:\files.txt")
after = Now + 60# / 3600# / 24#
f = FreeFile()
Do
REOPEN2:
    DoEvents
    If Now > after Then
        MsgBox "Wait c:\files.txt 60s overtime!"
        Exit Sub
    End If
    Open "c:\files.txt" For Input Lock Read Write As #f
    Line Input #f, ft
    Line Input #f, ft
    Line Input #f, ft
    Line Input #f, ft
    Line Input #f, ft
    Line Input #f, ft
    Close #f
    Kill "c:\files.txt"
    Exit Do
Loop
ft = Left(ft, 17)
ft_date=CDate(ft)
MsgBox "The newest file in [" & dn & "] is [" & fn & "], datetime is [" & ft_date & "]"
Command1.Enabled = True
Exit Sub
ERR0:
    Resume Next
ERR1:
    Resume REOPEN1
ERR2:
    Resume REOPEN2
End Sub

[cbm6666]

下面代码 时间有限 未再做细节的处理 只给你思路

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal Hprocess As Long, ByVal uExitCode As Long) As Long
Dim Rtn&, Rtn2&, Phwnd&, StartTm&
Private Sub Command1_Click()
MsgBox IIf(ChkValidPic("c:\test.jpg"), "正常图片", "无效图片")
End Sub

Function ChkValidPic(PicNm$) As Boolean
Rtn = Shell("cmd /c mspaint " & PicNm, vbHide)
StartTm = Timer
Do
Loop Until Timer - StartTm >= 0.5
Phwnd = FindWindow(vbNullString, "画图")
ChkValidPic = IIf(Phwnd > 0, False, True)
If Phwnd > 0 Then Call CloseExe(Phwnd)
End Function

Sub CloseExe(Pid As Long)
Dim Hprocess&
Hprocess = OpenProcess(1, False, Pid)
TerminateProcess Hprocess, 1
CloseHandle Hprocess
End Sub

[boopoo]

如果只是想显示图片，不管显示的图片是否完整，建议使用webbrowser装载图片，这样vb就不会死掉，而且可以显示出部分图片。但是没办法判断图片是否完整。

[farstaryao]

我也碰到这个问题了....

[灵易联盟]

我也碰到了,上次是正用2楼的方法后常,这次,不知道为什么,碰到损坏的图片就卡机了