LoadPicture载入图片的有关问题

2012-03-21

LoadPicture载入图片的问题最近写了一个程序，要大量接收来自客户上传的图片，客户先上传到服务器，我在从服

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

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

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

VB code

Private Sub Command1_Click()    Dim Pic As Picture    Set Pic = LoadPicture(App.Path & "\正常图片.jpg")    Picture1.Picture = PicEnd SubPrivate Sub Command2_Click()    Dim Pic As Picture    On Error Resume Next    Set Pic = LoadPicture(App.Path & "\有问题的图片.jpg")    Picture1.Picture = PicEnd SubPrivate Sub Command3_Click()    MsgBox PicEffective(App.Path & "\有问题的图片.jpg")End SubPrivate 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 Functioner:    PicEffective = FalseEnd Function

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

如果图片损坏的话，大小就不一样了
[解决办法]
Private Sub Command1_Click()
On Error GoTo Errh
Picture1.Picture = LoadPicture("c:\setup.jpg")
Errh:
If Err > 0 Then MsgBox "无效图片"
End Sub
[解决办法]
用#2楼的方法找出有问题的图片，然后把图片的物理地址记录到一个文本文件里，以便于下一步出来。
或者发现有问题的图片，记录物理位置后直接删除
具体你想做什么是你的事，另外，找张损坏了的图片，让它出错，然后看一下错误号，要根据错误号判断是不是这种错误，用if Err.Number=xxx then决定下一步怎么应对
[解决办法]
“只要一使用LoadPicture加载有问题的图片，vb直接死掉”这就需要在加载前检查文件是否完整了

[解决办法]
这个更深入一点，就是看你的图片是bmp还是JPG，根据不同的图片格式，读取图片的前几个字符判断下是否符合图片格式要求
[解决办法]
如果只是想显示图片，不管显示的图片是否完整，建议使用webbrowser装载图片，这样vb就不会死掉，而且可以显示出部分图片。但是没办法判断图片是否完整。

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

VB code

Private Sub Command1_Click()'找出文件夹内文件最新的更新时间(包括里面的子文件夹的文件哈) 要把这个文件夹内的所有文件的最后修改时间都要检查一次,并取出近的一个时间,(主要是检查这个文件夹里面的内容有没有更新),并取出这个文件最后一次的更新时间.环境是VB6Dim after As DoubleDim f As IntegerDim dn As StringDim fn As StringDim ft As StringDim ft_date As DateCommand1.Enabled = FalseOn Error GoTo ERR0Kill "c:\files.txt"dn = "c:\windows"On Error GoTo ERR1Shell ("cmd /c dir " & dn & "\*.* /a-d /b /s /o-d >c:\files.txt")after = Now + 60# / 3600# / 24#f = FreeFile()DoREOPEN1:    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 DoLoopOn Error GoTo ERR0Kill "c:\files.txt"On Error GoTo ERR2Shell ("cmd /c dir " & Chr(34) & fn & Chr(34) & ">c:\files.txt")after = Now + 60# / 3600# / 24#f = FreeFile()DoREOPEN2:    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 DoLoopft = Left(ft, 17)ft_date=CDate(ft)MsgBox "The newest file in [" & dn & "] is [" & fn & "], datetime is [" & ft_date & "]"Command1.Enabled = TrueExit SubERR0:    Resume NextERR1:    Resume REOPEN1ERR2:    Resume REOPEN2End Sub 
 
[解决办法]
下面代码 时间有限 未再做细节的处理 只给你思路  

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

热点排行