Hi Friends I have tried many times to convert this code into Vb.net but every time I got some exceptions ans errors and finally I am unable to Write this code into Vb.net please can some one please help me...
actually this is a Steganography project...
where two textboxes are used named txtmessage for the message to be hidden into image and txtpassword that acts as a key and a picture box named Picimage and two buttons named cmdEncode to Encode and cmddecode to Decode...
Option Explicit
Private Sub ArrangeControls()
Dim wid As Single
Width = picImage.Left + picImage.Width + Width - ScaleWidth + 120
Height = picImage.Top + picImage.Height + Height - ScaleHeight + 120
wid = ScaleWidth - txtMessage.Left - 120
If wid < 120 Then wid = 120
txtMessage.Width = wid
txtPassword.Width = wid
End Sub
' Encode this byte's data.
Private Sub EncodeByte(ByVal Value As Byte, ByVal used_positions As Collection, ByVal wid As Integer, ByVal hgt As Integer, ByVal show_pixels As Boolean)
Dim i As Integer
Dim byte_mask As Integer
Dim r As Integer
Dim c As Integer
Dim pixel As Integer
Dim clrr As Byte
Dim clrg As Byte
Dim clrb As Byte
Dim color_mask As Integer
byte_mask = 1
For i = 1 To 8
' Pick a random pixel and RGB component.
PickPosition used_positions, wid, hgt, r, c, pixel
' Get the pixel's color components.
UnRGB picImage.Point(r, c), clrr, clrg, clrb
If show_pixels Then
clrr = 255
clrg = clrg And &H1
clrb = clrb And &H1
End If
' Get the value we must store.
If Value And byte_mask Then
color_mask = 1
Else
color_mask = 0
End If
' Update the color.
Select Case pixel
Case 0
clrr = (clrr And &HFE) Or color_mask
Case 1
clrg = (clrg And &HFE) Or color_mask
Case 2
clrb = (clrb And &HFE) Or color_mask
End Select
' Set the pixel's color.
picImage.PSet (r, c), RGB(clrr, clrg, clrb)
byte_mask = byte_mask * 2
Next i
End Sub
' Decode this byte's data.
Private Function DecodeByte(ByVal used_positions As Collection, ByVal wid As Integer, ByVal hgt As Integer, ByVal show_pixels As Boolean) As Byte
Dim Value As Integer
Dim i As Integer
Dim byte_mask As Integer
Dim r As Integer
Dim c As Integer
Dim pixel As Integer
Dim clrr As Byte
Dim clrg As Byte
Dim clrb As Byte
Dim color_mask As Integer
byte_mask = 1
For i = 1 To 8
' Pick a random pixel and RGB component.
PickPosition used_positions, wid, hgt, r, c, pixel
' Get the pixel's color components.
UnRGB picImage.Point(r, c), clrr, clrg, clrb
' Get the stored value.
Select Case pixel
Case 0
color_mask = (clrr And &H1)
Case 1
color_mask = (clrg And &H1)
Case 2
color_mask = (clrb And &H1)
End Select
If color_mask Then
Value = Value Or byte_mask
End If
If show_pixels Then
picImage.PSet (r, c), RGB( _
clrr And &H1, _
clrg And &H1, _
clrb And &H1)
End If
byte_mask = byte_mask * 2
Next i
DecodeByte = CByte(Value)
End Function
' Translate a password into an offset value.
Private Function NumericPassword(ByVal password As String) As Long
Dim Value As Long
Dim ch As Long
Dim shift1 As Long
Dim shift2 As Long
Dim i As Integer
Dim str_len As Integer
' Initialize the shift values to different
' non-zero values.
shift1 = 3
shift2 = 17
' Process the message.
str_len = Len(password)
For i = 1 To str_len
' Add the next letter.
ch = Asc(Mid$(password, i, 1))
Value = Value Xor (ch * 2 ^ shift1)
Value = Value Xor (ch * 2 ^ shift2)
' Change the shift offsets.
shift1 = (shift1 + 7) Mod 19
shift2 = (shift2 + 13) Mod 23
Next i
NumericPassword = Value
End Function
' Pick an unused (r, c, pixel) combination.
Private Sub PickPosition(ByVal used_positions As Collection, ByVal wid As Integer, ByVal hgt As Integer, ByRef r As Integer, ByRef c As Integer, ByRef pixel As Integer)
Dim position_code As String
On Error Resume Next
Do
' Pick a position.
r = Int(Rnd * wid)
c = Int(Rnd * hgt)
pixel = Int(Rnd * 3)
' See if the position is unused.
position_code = "(" & r & "," & c & "," & pixel & ")"
used_positions.Add position_code, position_code
If Err.Number = 0 Then Exit Do
Err.Clear
Loop
End Sub
' Return the color's components.
Private Sub UnRGB(ByVal color As OLE_COLOR, ByRef r As Byte, ByRef g As Byte, ByRef b As Byte)
r = color And &HFF&
g = (color And &HFF00&) \ &H100&
b = (color And &HFF0000) \ &H10000
End Sub
Private Sub cmdDecode_Click()
Dim msg_length As Byte
Dim msg As String
Dim ch As Byte
Dim i As Integer
Dim used_positions As Collection
Dim wid As Integer
Dim hgt As Integer
Dim show_pixels As Boolean
If txtPassword.Text = "" Then
MsgBox ("Please Enter The Password to Continue...")
Exit Sub
End If
Screen.MousePointer = vbHourglass
DoEvents
' Initialize the random number generator.
Rnd -1
Randomize NumericPassword(txtPassword.Text)
wid = picImage.ScaleWidth
hgt = picImage.ScaleHeight
show_pixels = chkShowPixels.Value
Set used_positions = New Collection
' Decode the message length.
msg_length = DecodeByte(used_positions, wid, hgt, show_pixels)
' Decode the message.
For i = 1 To msg_length
ch = DecodeByte(used_positions, wid, hgt, show_pixels)
msg = msg & Chr$(ch)
Next i
picImage.Picture = picImage.Image
txtMessage.Text = msg
Screen.MousePointer = vbDefault
MsgBox ("Decryption Completed....")
End Sub
Private Sub cmdEncode_Click()
Dim msg As String
Dim i As Integer
Dim used_positions As Collection
Dim wid As Integer
Dim hgt As Integer
Dim show_pixels As Boolean
If txtMessage.Text = "" Then
MsgBox ("Please Enter Text to Encrypt...")
Exit Sub
ElseIf txtPassword.Text = "" Then
MsgBox ("Please Enter Password To Protect Data...")
Exit Sub
End If
Screen.MousePointer = vbHourglass
DoEvents
' Initialize the random number generator.
Rnd -1
Randomize NumericPassword(txtPassword.Text)
wid = picImage.ScaleWidth
hgt = picImage.ScaleHeight
msg = Left$(txtMessage.Text, 255)
show_pixels = chkShowPixels.Value
Set used_positions = New Collection
' Encode the message length.
EncodeByte CByte(Len(msg)), _
used_positions, wid, hgt, show_pixels
' Encode the message.
For i = 1 To Len(msg)
EncodeByte Asc(Mid$(msg, i, 1)), _
used_positions, wid, hgt, show_pixels
Next i
picImage.Picture = picImage.Image
Screen.MousePointer = vbDefault
MsgBox ("Encryption Complete..." & vbNewLine & vbNewLine & "You Can Save Picture Using Menu...")
End Sub
Private Sub Form_Load()
picImage.ScaleMode = vbPixels
picImage.AutoRedraw = True
dlgImage.InitDir = App.Path
ArrangeControls
End Sub
|