把文本藏入图片中

 

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

 

这可以用Visual Basic 6.0实现，首先我们将文字转化为数字，再将图片中的每个点的RGB值取出，将数字每三个分别与Ｒ值，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(ByVal 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值的修改范围为～，很难区别目标图片与源图片，因此可以用于文件的加密。