在RTF格式中提取图片并保存成文件

最新推荐文章于 2022-04-27 10:24:00 发布

qianjiu

最新推荐文章于 2022-04-27 10:24:00 发布

阅读量1.5k

点赞数

分类专栏： WINform 文章标签： rtf string imagelist integer function insert

本文链接：https://blog.youkuaiyun.com/qianjiu/article/details/5573076

版权

WINform 专栏收录该内容

29 篇文章

订阅专栏

本文介绍了一个VB.NET过程，用于从富文本格式(RTF)中提取图片数据，并将其保存为文件。此外，该过程还将修改后的RTF文本存入数据库。文中详细展示了如何解析RTF中的图片信息，包括尺寸数据，并将二进制图片数据转换为文件。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Friend Sub getpic(ByVal RT As String, ByVal remid As String) 'Dim RTlenth As Int64 = RT.Rtf.Length 'Dim Sindex As Int64 'Dim Eindex As Int64 'Dim rtfPIC As String 'Sindex = RT.Rtf.ToString.IndexOf("{/pict/") 'rtfPIC = RT.Rtf.Substring(Sindex, RTlenth - Sindex) 'Eindex = rtfPIC.IndexOf("}") 'rtfPIC = Left(rtfPIC, Eindex + 1) 'MsgBox(rtfPIC) 'Dim windex As Int16 = rtfPIC.IndexOf("/picw") 'Dim hindex As Int16 = rtfPIC.IndexOf("/pich") 'Dim heindex As Int16 = rtfPIC.IndexOf("/picwgoa") 'Dim Pwith As Int16 = rtfPIC.Substring(windex + 5, hindex - (windex + 5)) 'Dim pheight As Int16 = rtfPIC.Substring(hindex + 5, heindex - (hindex + 5)) 'MsgBox(Pwith & "——" & pheight) 'Dim imgdata As String 'imgdata = rtfPIC.Substring(rtfPIC.IndexOf(" ") + 2, rtfPIC.Length - rtfPIC.IndexOf(" ") - 4) Dim _RtfText As String = RT Dim savertf As String = RT Dim _ImageList As IList(Of String) = New List(Of String)() Dim repaceinglist As IList(Of String) = New List(Of String)() While True Dim _Index As Integer = _RtfText.IndexOf("pichgoal") If _Index = -1 Then Exit While End If _RtfText = _RtfText.Remove(0, _Index + 8) '_Index = _RtfText.IndexOf(vbCr & vbLf) 'Dim _Temp As Integer = Convert.ToInt32(_RtfText.Substring(0, _Index)) '_RtfText = _RtfText.Remove(0, _Index) Dim index As Int64 = _RtfText.IndexOf(vbLf) + 1 _RtfText = _RtfText.Remove(0, index) Dim instr As String Dim inte As Int64 = _RtfText.IndexOf("}") instr = _RtfText.Substring(0, inte) ' repaceinglist.Add(instr) instr = instr.Replace(vbCr & vbLf, "") ' _RtfText = _RtfText.Replace(vbCr & vbLf, "") _Index = _RtfText.IndexOf("}") If instr = _RtfText.Substring(0, _Index) Then MsgBox("一样") End If _ImageList.Add(instr) _RtfText = _RtfText.Remove(0, _Index) End While Dim i As Integer = 0 While i <> _ImageList.Count Dim chatadr As String = adrmyPersonal & Uinflist(0).uID & "/" & remid & "/pic/" If My.Computer.FileSystem.DirectoryExists(chatadr) = False Then My.Computer.FileSystem.CreateDirectory(chatadr) End If Dim chatfileadr As String = chatadr & Now.Date & "_" & Now.Hour & "-" & Now.Minute & "-" & Now.Second & ".jpg" Dim _File As System.IO.FileStream = New FileStream(chatfileadr, System.IO.FileMode.Create) Dim _Count As Integer = _ImageList(i).Length / 2 Dim z As Integer = 0 While z <> _Count Dim _TempText As String = _ImageList(i)(z * 2).ToString() + _ImageList(i)((z * 2) + 1).ToString() _File.WriteByte(Convert.ToByte(_TempText, 16)) z += 1 End While _File.Close() savertf = savertf.Replace(repaceinglist(i), "<" & chatfileadr & ">") i += 1 End While Dim insqlstr As String = jiami(savertf, "11111111") Dim mysql As New ClassSQL If mysql.SETconn(Uinflist(0).uID, remid) = True Then Dim sqlinsert As String = "insert into chatlog(cbody,ctime) values ('" & insqlstr & "','" & Now.ToString & "')" If mysql.insert(sqlinsert) Then MsgBox("数据插入成功") End If End If End Sub Friend Function setnewRTF() As RichTextBox Dim rtb As New RichTextBox Dim str As String = "{/rtf1/ansi/ansicpg936/deff0/deflang1033/deflangfe2052{/fonttbl{/f0/fnil/fcharset134 " & _ "/'cb/'ce/'cc/'e5;}}" & _ "/viewkind4/uc1/pard/lang2052/f0/fs18/par" rtb.Rtf = str Return rtb End Function