分享
 
 
 

将文本藏入图片 选择自 VirleneCheng 的 Blog

王朝other·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

一般看来文字与图片是毫不相同的,但是它们却有共同点。图片是由一个个点组成的,而这些点的颜色值可由数字组成,文字可由ASCII码表示,这就使得数字成为它们之间沟通道桥梁。因此就可以将文本藏入图片中。

这可以用Visual Basic 6.0实现,首先我们将文字转化为数字,再将图片中的每个点的RGB值取出,将数字每三个分别与R值,G值,B值相加或相减,接着把RGB值还原为图片中的点,至此我们已经将文本藏入图片。要取出文本怎么办呢?我们可以把源图片与目标图片进行对比,将到的差值转化为文本,就实现了文本的还原。

具体作法:先建立窗体文件frmPictureText.frm和模块文件modPictureText.bas

模块文件:

Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal _

hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

'用于获得图片的象素

Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x _

As Long, ByVal y As Long) As Long '用于获得图片指定点的RGB值

Public Type BITMAP

bmType As Long

bmWidth As Long

bmHeight As Long

bmWidthBytes As Long

bmPlanes As Integer

bmBitsPixel As Integer

bmBits As Long

End Type

Function HexDec(Number As String) As Integer '将十六进制转化为十进制

Dim n As Integer, dec As String, tmp As Integer

For n = 1 To Len(Number)

dec = Mid(Number, n, 1)

If Asc(dec) >= 65 Then

dec = UCase(dec)

dec = Format(Asc(dec) - 55)

End If

tmp = Val(dec) * 16 ^ (Len(Number) - n)

HexDec = HexDec + tmp

Next n

End Function

窗体文件:建立两个图片框:picSource用于显示源图片,picObject用于显示目标图片,

建立两个文本框:txtSource用于显示源文本,txtObject用于显示还原的文本,并设置为各多行显示,建立两个命令按钮:cmdTextToPicture用于把文本藏入图片,cmdPictureToText用于还原文本。

Private Sub Form_Load()

picSource.AutoRedraw = True: picObject.AutoRedraw = True

picSource.AutoSize = True: picObject.AutoSize = True

picSource.Picture = LoadPicture("c:\test.bmp")

picObject.Height = picSource.Height '设置目标图片框的Height和

picObject.Width = picSource.Width 'Width属性与源图片相同,保证

'目标图片的大小和源文件相同

End Sub

Private Sub cmdTextToPicture_Click()

Dim numX As Integer, chrTmp As String, numTmp As Integer, numY As Integer, word As String

Dim souPixel As BITMAP, souTop As Integer, souLeft As Integer

Dim souColor As Long, souGetcolor As String, numN As Integer

Dim tmpWord As String, numDifRed As Integer, numDifGreen As Integer, numDifBlue As Integer

Dim newRed As Integer, newGreen As Integer, newBlue As Integer

On Error Resume Next

Kill "c:\temp1.txt"

Open "c:\temp1.txt" For Append As #1 '将文本转化为数字,并存入文件

For numX = 1 To Len(txtSource.Text)

numTmp = Asc(Mid(txtSource.Text, numX, 1))

chrTmp = Format(numTmp)

If numTmp >= 0 Then chrTmp = "+" & chrTmp

For numY = 1 To Len(chrTmp)

word = Format(Asc(Mid(chrTmp, numY, 1)))

Print #1, word;

Next numY

Next numX

Close #1

Open "c:\temp1.txt" For Input As #2

GetObject picSource.Picture.Handle, Len(souPixel), souPixel

picObject.Picture = Nothing: picObject.Cls

For souTop = 0 To souPixel.bmHeight - 1

For souLeft = 0 To souPixel.bmWidth - 1

'取出图片各点的RGB值

souColor = GetPixel(picSource.hdc, souLeft, souTop)

souGetcolor = Hex(souColor)

numN = 6 - Len(souGetcolor)

souGetcolor = String(numN, "0") & souGetcolor

'取出三个数字

If Not (EOF(2)) Then

tmpWord = Input(3, #2)

numDifRed = Val(Left(tmpWord, 1))

numDifGreen = Val(Mid(tmpWord, 2, 1))

numDifBlue = Val(Right(tmpWord, 1))

End If

'把数字与R值,G值,B值相加或相减

newRed = HexDec(Right(souGetcolor, 2)) - numDifRed

If newRed < 0 Then newRed = HexDec(Right(getcolor, 2)) + numDifRed

newGreen = HexDec(Mid(souGetcolor, 3, 2)) - numDifGreen

If newGreen < 0 Then newGreen = HexDec(Mid(souGetcolor, 3, 2)) + numDifGreen

newBlue = HexDec(Left(souGetcolor, 2)) - numDifBlue

If newBlue < 0 Then newBlue = HexDec(Left(souGetcolor, 2)) + numDifBlue

numDifRed = 0: numDifGreen = 0: numDifBlue = 0

DoEvents

'形成目标图片

picObject.PSet (souLeft, souTop), RGB(newRed, newGreen, newBlue)

Next souLeft

Next souTop

Close #2

SavePicture picObject.Image, "c:\object.bmp"

picObject.Picture = LoadPicture("c:\object.bmp")

End Sub

Private Sub cmdPictureToText_Click()

Dim Pixel As BITMAP

Dim souTop As Integer, souLeft As Integer

Dim souColor As Long, objColor As Long, souGetcolor As String, objGetcolor As String

Dim souRed As Integer, souGreen As Integer, souBlue As Integer

Dim objRed As Integer, objGreen As Integer, objBlue As Integer

Dim souN As Integer, objN As Integer

Dim numDifRed As Integer, chrDifRed As String

Dim numDifGreen As Integer, chrDifGreen As String

Dim numDifBlue As Integer, chrDifBlue As String

Dim Difference As String, numTmp As Integer, chrTmp As String, tmpWord As String, word As String

On Error Resume Next

GetObject picSource.Picture.Handle, Len(Pixel), Pixel '获取图片的象素

Kill "c:\temp2.txt" '如果存在"temp2.txt"文件,则将它清除

Open "c:\temp2.txt" For Append As #3

For souTop = 0 To Pixel.bmHeight - 1

For souLeft = 0 To Pixel.bmWidth - 1

'获得源图片各点的RGB值

souColor = GetPixel(picSource.hdc, souLeft, souTop)

souGetcolor = Hex(souColor)

souN = 6 - Len(souGetcolor)

souGetcolor = String(souN, "0") & souGetcolor

souRed = HexDec(Right(souGetcolor, 2)) '转化为Red,Green,Blue的值

souGreen = HexDec(Mid(souGetcolor, 3, 2))

souBlue = HexDec(Left(souGetcolor, 2))

'获得目标图片各点的RGB值

objColor = GetPixel(picObject.hdc, souLeft, souTop)

objGetcolor = Hex(objColor)

objN = 6 - Len(objGetcolor)

objGetcolor = String(objN, "0") & objGetcolor

objRed = HexDec(Right(objGetcolor, 2))

objGreen = HexDec(Mid(objGetcolor, 3, 2))

objBlue = HexDec(Left(objGetcolor, 2))

numDifRed = souRed - objRed '将差值存入文件

chrDifRed = Format(numDifRed)

If numDifRed < 0 Then chrDifRed = Format(objRed - souRed)

numDifGreen = souGreen - objGreen

chrDifGreen = Format(numDifGreen)

If numDifGreen < 0 Then chrDifGreen = Format(objGreen - souGreen)

numDifBlue = souBlue - objBlue

chrDifBlue = Format(numDifBlue)

If numDifBlue < 0 Then chrDifBlue = Format(objBlue - souBlue)

Difference = chrDifRed & chrDifGreen & chrDifBlue

Print #3, Difference;

Next souLeft

Next souTop

Close #3

Open "c:\temp2.txt" For Input As #4 '从文件还原文字

Do While Not EOF(4)

numTmp = Input(2, #4)

chrTmp = Chr(Val(numTmp))

If (Len(tmpWord) > 1) And (chrTmp = "+" Or chrTmp = "-") Then

word = Chr(Val(tmpWord))

txtobject.Text = txtobject.Text & word

tmpWord = ""

End If

tmpWord = tmpWord & chrTmp

Loop

txtobject.Text = txtobject.Text & Chr(Val(tmpWord))

Close #4

End Sub

以上程序在Windows98系统中VB6.0中调试通过。

综上所述,此方法对图片各点的RGB值的修改范围为0~9,很难区别目标图片与源图片,因此可以用于文件的加密。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有