Steganography is a technique to insert a secret message inside an image.
TGD Consulting is a software house that use a lo Rebol, they made the following software in pure Rebol.
To send a secret message you have to:
- load an image
- write you message
- choose a secret key
Only your friend, with this software and knowing the key, can read your secret message.
Here the source:
REBOL [
Title: "Stegano-It!"
Version: 1.4.2
Date: 5-Aug-2007/8:49:19+1:00
Name: "Stegano-It!"
File: %SteganoIt.r
Author: "Dirk Weyand"
Rights: "TGD-Consulting"
Home: http://www.TGD-Consulting.DE/Download.html
Needs: 'View
Purpose: "A tool to hide information in images."
Comment: {
TGD-Consulting's Stegano-It! is
based on REBOL/View. This tool
allows you to hide information in
images using steganography algorithms.
With Stegano-It! you can easily
share confidental messages with
friends, business partners and
nobody else will recognise it.
Only four steps are necessary
to get a steganographic image:
1. Load an image . . . . . . . . . . . . . . . . .
2. Enter your private-key . . . . . . . . . .
3. Type & encrypt your message . . .
4. Save the new image . . . . . . . . . . . .
Try Stegano-It! and reap the benefits.}
Language: 'en
History: [
{0.0.1 ^-26-Jun-2005 ^-"initial release"^/}
{0.1.0 ^-02-Jul-2005 ^-"added IO-handling"^/}
{0.1.1 ^-03-Jul-2005 ^-"enhanced GUI-skin"^/}
{0.2.0 ^-10-Jul-2005 ^-"added private-key"^/}
{0.2.1 ^-11-Jul-2005 ^-"optimized en/decoding"^/}
{0.3.0 ^-12-Jul-2005 ^-"added clipboard-support"^/}
{0.4.0 ^-13-Jul-2005 ^-"added View 1.3 workarounds"^/}
{0.5.0 ^-14-Jul-2005 ^-"added random noise"^/}
{0.5.1 ^-15-Jul-2005 ^-"fixed to run on AmigaOS"^/}
{1.0.0 ^-17-Jul-2005 ^-"first public-release"^/}
{1.1.0 ^-23-Jul-2005 ^-"enhanced encoding density"^/}
{1.1.1 ^-07-Aug-2005 ^-"fixed image loading"^/}
{1.1.2 ^-23-Aug-2005 ^-"optimized code"^/}
{1.1.3 ^-01-Sep-2005 ^-"fixed hash-table bug"^/}
{1.1.4 ^-14-Oct-2005 ^-"fixed sliders"^/}
{1.2.0 ^-23-Dec-2005 ^-"added ESC-key control"^/}
{1.3.0 ^-29-Jan-2006 ^-"added REBOL/View check"^/}
{1.3.1 ^-16-Feb-2006 ^-"fixed ? hot-key"^/}
{1.4.0 ^-18-Feb-2006 ^-"added mouse-wheel support"^/}
{1.4.1 ^-08-Jul-2007 ^-"enhanced cipher-chaining-key"^/}
{1.4.2 ^-05-Aug-2007 ^-"removed compress fingerprints"^/}
]
License: {(C) TGD-Consulting
End User License Agreement
IMPORTANT. READ CAREFULLY.
This Lisense Agreement (AGREEMENT) is a legal contract between you and TGD-Consulting (TGD) for the limited use of this TGD software product (SOFTWARE), which includes computer software, and, as applicable, associated media, printed materials, and electronic documentation.
This SOFTWARE is licensed, not sold, to you. TGD retains all right, title and interest in and to the SOFTWARE including, without limitation, all intellectual property rights relating to or embodied in the SOFTWARE.
TGD grants you an non-exclusice license to use the SOFTWARE for personal use only. Commercial use requires seperate licensing from TGD. This AGREEMENT is not assignable or transferable without prior written approval of TGD.
The copyright, trademark, and other proprietary rights notices contained in the SOFTWARE may not be removed, altered, or added to in any way. You may not reverse engineer, decompress, decompile, or disassemble the SOFTWARE. You may not redistribute the SOFTWARE without prior written approval of TGD.
The SOFTWARE key that unlocks additional features and components may not be distributed, published, or transferred. Only the registered licensee of the SOFTWARE key may enable or use the additional features and components of this SOFTWARE.
THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, WITHOUT ANY EXPRESS OR IMPLIED WARRANTY OF ANY KIND. IN NO EVENT WILL TGD OR THE AUTHOR OF THE SOFTWARE BE HELD LIABLE FOR ANY DAMAGES ARISING FROM THE USE OF THIS SOFTWARE.
You agree to use the SOFTWARE in compliance with all applicable laws and regulations including all laws governing the export or re-export of the SOFTWARE. You agree to indemnify TGD from and against your violation of any such laws or regulations.
This AGREEMENT contains the entire agreement between the parties with respect to the license of the SOFTWARE. This AGREEMENT supercedes any prior license agreement of the SOFTWARE.
By installing or using the SOFTWARE, you are consenting to be bound by and are becoming a party to this AGREEMENT. IF YOU DO NOT AGREE TO ALL OF THE TERMS OF THIS AGREEMENT, DO NOT INSTALL OR USE THE SOFTWARE.}
]
if not all [value? 'view? view?] [
until [
print "^L^/Stegano-It! requires REBOL/View !!!^/"
wait 0.15
print "^L^/^/"
not none? wait [system/ports/input 0.15]
]
quit
]
view: func do head insert find mold third :view "/new" {/kf "Keeps feel of window face"
} do head replace mold second :view "view-face/feel: window-feel" {if not kf [view-face/feel: system/view/window-feel]}
pixels: make hash! []
color-index: none
key-index: none
wraped: false
noise: true
noise-ratio: 5
main-offset: none
img: none
img-index: 0
img-index-max: 0
crypt-img: none
current-img: none
last-img: %./My-Image.jpg
bg-color: farbe: sky
bg-effect: compose [gradient 0x-1 (farbe) (farbe * 0.6) grid 700x4 690x2 0x1 (farbe / 2) blur blur blur]
e-color: add farbe / 2 farbe / 6
debug: false
lic-read: ulf: false
copydate: copy find/tail second system/script/Header/History "^-"
clear find copydate " "
copydate: to date! copydate
either greater? now/year copydate/year [copydate: join form copydate/year ["-" now/year]] [copydate: form copydate/year]
random/seed now/precise
btn-styles: stylize [
btn: button 80x26 no-wrap font [size: 16 colors/1: (farbe + 80)] edge [size: 1x1 effect: 'bevel color: farbe / 3] effect [merge gradcol -1x0 45.45.45 120.120.120] with [
init: [
edge: make edge []
font/color: first font/colors
if all [image not effect] [
effect: copy [fit]
if color [append effect reduce ['colorize color]]
if all [colors greater? length? colors 1] [
effects: compose/deep [[fit colorize (first colors)]
[fit colorize (second colors)]]
]
]
if not any [color colors effect effects] [
effects: [[gradient 0x1 66.120.192 44.80.132] [gradient 0x-1 66.120.192 44.80.132]]
]
]
]
small-btn: btn 19x19
]
either found? suffix: find/last system/script/Header/File "." [filename: copy/part system/script/Header/File subtract length? system/script/Header/File length? suffix ] [filename: copy system/script/Header/File ]
config-file: join filename ".config"
message: func [
"Display a message window"
str [string! block! object!] "Message to display"
/offset xy [pair!] "Offset of window"
/color colors [tuple! block!] "Used colors"
/timeout time
/local lay result hdl msg c1 c2 c3 f x-hdl x-txt x-p
] [
lay: either all [object? str in str 'type str/type = 'face]
[str] [
c1: green c2: c3: farbe + 80
hdl: " N O T E : "
if color [either block? colors [set [c1 c2 c3] colors] [c1: colors]]
either block? str [
str: reduce str
set [hdl msg] str
str: reform next next str
foreach n [hdl msg str] [
if all [found? get n not string? get n] [set n form get n]
]
] [
msg: str
str: ""
]
f: layout [h1 copy hdl c1 center middle edge [color: e-color size: 1x1 effect: 'bevel]]
x-hdl: 20 - 44 + first f/size
either empty? str
[f: layout [across text bold copy msg c2 middle]]
[f: layout [across text bold copy msg c2 middle text copy str c3 middle]]
x-txt: subtract first f/size 44
either greater? x-txt x-hdl [x-p: to integer! (x-txt - x-hdl / 2)] [x-p: 0]
result: copy [
styles btn-styles
backdrop effect bg-effect
across
pad x-p
btn x-hdl keycode #"^M" copy hdl center middle font [size: 20 colors: compose [(c1) (c1 - 40)]] [result: true hide-popup] [result: true hide-popup] return
text bold copy msg c2 middle with [feel: none]
]
if not empty? str [insert tail result [text copy str c3 middle with [feel: none]]]
layout result
]
result: none
either offset [inform/offset/timeout lay xy time] [inform/timeout lay time]
result
]
scroll-slider-text: func [tf sf /local tmp size sms] [
if none? tf/para [exit]
size: size-text tf
sms: subtract sf/size 2 * sf/edge/size
tmp: min 0x0 tf/size - size - 0x8
either sf/size/x > sf/size/y [
tf/para/scroll/x: sf/data * first tmp
either any [system/version > 1.3.0 link?] [sf/pane/1/size/x: max 10 to integer! divide sms/x max 1 (first size) / tf/size/x ] [sf/pane/size/x: max 10 to integer! divide sms/x max 1 (first size) / tf/size/x ]
] [
tf/para/scroll/y: sf/data * second tmp
either any [system/version > 1.3.0 link?] [sf/pane/1/size/y: max 10 to integer! divide sms/y max 1 (second size) / tf/size/y ] [sf/pane/size/y: max 10 to integer! divide sms/y max 1 (second size) / tf/size/y ]
]
sf/state: -1
show [tf sf]
]
scroll-smooth: func [dx tf sf /init /local d] [
d: divide 2 max sf/size/x sf/size/y
either positive? dx [
while [all [lesser? sf/data 1 positive? dx]] [
sf/data: min 1 sf/data + d
dx: subtract dx d
scroll-slider-text tf sf
]
] [
while [all [positive? sf/data 1 negative? dx]] [
sf/data: max 0 sf/data - d
dx: add dx d
scroll-slider-text tf sf
]
]
if init [tf/para/scroll: 0x0]
]
scroll-wheel: func [page n tf sf /init /end] [
either init [
either end [
scroll-smooth/init (n * (either page [tf/size/y] [tf/font/size])) tf sf
] [
scroll-smooth/init divide (n * (either page [tf/size/y] [tf/font/size])) max 1 second size-text tf tf sf
]
if all [not lic-read greater? sf/data 0.97] [lic-read: true]
] [
either end [
scroll-smooth (n * (either page [tf/size/y] [tf/font/size])) tf sf
] [
scroll-smooth divide (n * (either page [tf/size/y] [tf/font/size])) max 1 second size-text tf tf sf
]
]
]
scroll-area: func [page n af /local d size] [
if none? af/para [exit]
size: size-text af
d: (n * (either page [af/size/y] [af/font/size]))
either positive? d [
while [all [positive? add size/y - af/size/y + 8 af/para/scroll/y positive? d]] [
d: subtract d 2
af/para/scroll/y: max subtract af/para/scroll/y 2 negate size/y - af/size/y + 8
show af
]
] [
while [all [negative? af/para/scroll/y negative? d]] [
d: add d 2
af/para/scroll/y: min add af/para/scroll/y 2 0
show af
]
]
]
license-agreement: layout [
styles btn-styles
backdrop effect bg-effect
across
banner join system/script/header/Name " - E U L A" 416 either any [system/version > 1.3.0 link?] [255.240.180] [yellow + 100] no-wrap with [feel: none]
return
space 0
f-txt: text 400x150 bg-color / 3 bg-color + 80 edge [color: e-color size: 2x2 effect: 'ibevel] with [feel: none]
f-sld: slider f-txt/size/y * 0x1 + 16x0 bg-color / 3 bg-color / 2 edge [color: e-color] [scroll-slider-text f-txt f-sld f-txt/para/scroll: 0x0 if greater? face/data 0.97 [lic-read: true]] return
pad 1x10 return
btn "ACCEPT" "ACCEPTED" keycode [#"^M"] font [size: 12] edge [size: 2x2] [either lic-read [unview license-agreement] [message/timeout {Read the complete EULA before you accept the agreement !!!} 0:00:06 hide-popup]] [either lic-read [unview license-agreement] [message/timeout {Read the complete EULA, before you accept the agreement!!!} 0:00:06 hide-popup]]
pad 256
btn 80 "Cancel" "Canceld" keycode [#"^["] font [size: 12] edge [size: 2x2] [unview/all quit] [unview/all quit]
key keycode [up page-up] [scroll-wheel/init true -1 f-txt f-sld]
key keycode [down page-down] [scroll-wheel/init true 1 f-txt f-sld]
key keycode [home] [scroll-wheel/init/end true -1 f-txt f-sld]
key keycode [end] [if lic-read [scroll-wheel/init/end true 1 f-txt f-sld]]
]
insert find/tail system/script/header/license "(C)" join " " copydate
f-txt/text: copy system/script/header/license
either any [system/version > 1.3.0 link?] [f-sld/pane/1/edge/color: e-color ] [f-sld/pane/edge/color: e-color ]
license-agreement/feel: make license-agreement/feel [
detect: func [face event /local rc] [
rc: true
switch event/type [
scroll-line [scroll-wheel/init false event/offset/y f-txt f-sld]
scroll-page [scroll-wheel/init true event/offset/y f-txt f-sld]
key [if found? face: find-key-face face event/key [
if get in face 'action [do-face face event/key]
rc: false
]
]
close [quit]
]
if rc [event]
]
]
m: 0
either exists? join filename ".license" [
either all [not error? try [do load join filename ".license" ulf: false] value? 'expiry value? 'license-key value? 'licensee] [
either date? expiry [
either greater? now/date expiry [
m: 3
] [
either equal? license-key checksum/key read system/options/script join system/script/Header/Name [user-prefs/name expiry licensee] [ulf: true ] [m: 2 ]
]
] [
either equal? license-key checksum/key read system/options/script join system/script/Header/Name [user-prefs/name licensee] [ulf: true ] [m: 2 ]
]
] [m: 2 ]
] [m: 1 ]
if any [not ulf not exists? config-file] [
scroll-slider-text f-txt f-sld
view/kf center-face license-agreement
]
switch m [
1 [message/color reduce [" A T T E N T I O N : " reform [system/script/Header/Name "license-file not found !!!"] reform ["Please contact" system/script/Header/Rights "to purchase a license."]] yellow
]
2 [message/color reduce [" A T T E N T I O N : " reform ["Your" system/script/Header/Name "license-key is not valid !!!"] reform ["Please contact" system/script/Header/Rights "to get a new license-file."]] yellow
]
3 [message/color reduce [" A T T E N T I O N : " reform ["Your" system/script/Header/Name "license-key is expired !!!"] reform ["Please contact" system/script/Header/Rights "to get a new license-file."]] yellow
]
]
hot-key-wrapped?: func [
key [string! char!]
] [
either all [found? system/view/focal-face system/view/caret] [
if all [found? system/view/highlight-start found? system/view/highlight-end] [
system/view/caret: remove/part system/view/highlight-start subtract index? system/view/highlight-end index? system/view/highlight-start
system/view/highlight-start: system/view/highlight-end: none
]
insert system/view/caret form key
system/view/caret: next system/view/caret
show system/view/focal-face
true
] [false ]
]
either equal? (xor 64#{//8=} 64#{AAA=}) 64#{//8=} [nxor: :xor ] [
nxor: func [
{Returns the first value exclusive ORed with the second.}
value1 [binary!]
value2 [binary!]
/local rc i bit a b exp byte
] [
rc: make binary! []
i: 0
loop min length? value1 length? value2 [
i: i + 1
a: enbase/base to string! to char! pick value1 i 2
b: enbase/base to string! to char! pick value2 i 2
bit: 0
byte: 0
loop exp: 8 [
bit: bit + 1
exp: exp - 1
if not equal? pick a bit pick b bit [
byte: byte + power 2 exp
]
]
insert tail rc to char! byte
]
return rc
]
]
compress~: func [
data
/local rc
] [
rc: compress data
remove/part skip tail rc -2 2
remove/part rc 2
]
decompress~: func [
data
/local rc
] [
rc: copy data
insert tail rc 64#{AAA=}
insert rc 64#{eJw=}
decompress head rc
]
load-config: func [
"Loads the configuration file."
myfile [file! string!] "The configuration file."
/local mylastimg myoffset mynoise mysnr
] [
if not error? try [set [mylastimg myoffset mynoise mysnr] read/direct/lines to file! myfile] [
if found? mylastimg [error? try [last-img: to file! mylastimg]]
if found? myoffset [error? try [main-offset: to pair! myoffset]]
if found? mynoise [error? try [noise: to logic! to integer! mynoise]]
if found? mysnr [error? try [noise-ratio: to integer! mysnr]]
]
]
shutdown: func ["exit the programm." ] [
if ulf [write config-file reduce [last-img newline lay-main/offset newline]]
unview/all
either debug [halt] [quit]
]
connect?: does [
if request ["Connect to the homepage of TGD-Consulting ?" "Browse" "Cancel"] [
error? try [browse system/script/header/Home]
]
]
display: func [
"displays the image as thumb preview."
img
/local ratio
] [
if image? img [
img-index: index? img
img-index-max: multiply img/size/1 img/size/2
ratio: divide first img/size second img/size
either greater-or-equal? ratio divide 240 200 [
pnl-img/size: to pair! reduce [230 min 190 to integer! divide 230 ratio]
] [
pnl-img/size: to pair! reduce [min 230 to integer! multiply 190 ratio 190]
]
pnl-img/image: img
clear pnl-img/text
pnl-img/offset: max 0x0 pnl-img/parent-face/size - 5 - pnl-img/size / 2
show [pnl-img]
]
]
load-image: func [
"load a image."
/local path file
] [
set [path file] request-file/title/file/filter/path "Choose an image to load:" "Load" last-img ["*.jpg" "*.png" "*.gif" "*.bmp"]
if all [found? file exists? join path file] [
last-img: current-img: join path file
crypt-img: none
img: load current-img
]
]
save-image: func [
"load a image."
/local path file suffix
] [
either found? current-img [
set [path file] split-path current-img
if found? suffix: find/last file "." [file: copy/part file subtract length? file length? suffix ]
either image? crypt-img [save/png join file %_crypt.png crypt-img ] [
message/color/timeout [" A T T E N T I O N : " "No encrypted image to save !!!" "Please encrypt your message first."] yellow 0:00:06
hide-popup
focus smsg
]
] [
message/color/timeout [" A T T E N T I O N : " "No image to save !!!" "Please load an image first."] yellow 0:00:06
hide-popup
]
]
get-key-stream: func [
len [integer!] "Länge des zu erzeugenden Key Streams."
key [binary!] "Der Key."
/local rc
] [
rc: copy 64#{}
insert/dup rc key to integer! 1 + divide len length? key
rc: copy/part rc len
]
get-key-chain: func [
"Erzeugt Cipher-Block-Chaining Key."
IV [series!] "initial Vektor."
l [number!] "Länge des Key."
/local i cbc key
] [
cbc: copy IV
i: l - length? IV
key: copy cbc
while [positive? i] [
insert tail cbc key: copy/part checksum/method key 'md5 i
i: i - length? key
]
return copy/part cbc l
]
to-pixel: func [
val [integer!] "Wert der in Pixel kodiert wird."
/no-tuple "Rückgabewert vom Typ block!"
/local r g b
] [
r: (to integer! power val (1 / 3))
g: (to integer! power (val: val - power r 3) (1 / 2))
b: (to integer! val - power g 2)
either no-tuple [reduce [r g b]] [to tuple! reduce [r g b]]
]
from-pixel: func [
pix [tuple! block!] "RGB-Farbwert"
] [to integer! ((power pix/1 3) + (power pix/2 2) + pix/3) ]
get-bit: func [
{Liest verstecktes Bit aus dem RGB-Farbwert des Pixel.}
i [integer!] "genaue Position RGB-Farbwertes."
] [odd? pick pick img img-index i ]
set-even-color: func [
{Versteckt ein "0"-Bit im RGB-Farbwert des Pixel.}
i [integer!] "genaue Position RGB-Farbwertes."
/local col pxl
] [
pxl: pick img img-index
col: pick pxl i
if odd? col [
either equal? col 255 [col: col - 1] [col: col + 1]
pxl: poke pxl i col
poke img img-index pxl
]
]
set-odd-color: func [
{Versteckt ein "1"-Bit im RGB-Farbwert des Pixel.}
i [integer!] "genaue Position RGB-Farbwertes."
/local col pxl
] [
pxl: pick img img-index
col: pick pxl i
if even? col [
col: col + 1
pxl: poke pxl i col
poke img img-index pxl
]
]
wrap-next: func [
"Liefert das nächste Element in der Liste."
lst [series!]
] [
if tail? lst: next lst [lst: head lst]
return lst
]
decode-byte: func [
"Decodes a byte from the datastream."
/group "no gap between the bits."
/local rc exp offset
] [
rc: 0
loop exp: 8 [
exp: exp - 1
if get-bit color-index [rc: rc + power 2 exp]
insert tail pixels img-index
either group [
if equal? color-index: add color-index // 3 1 1 [img-index: add img-index 1]
] [
offset: first key-index: wrap-next key-index
color-index: add offset // 3 1
if greater? img-index: add img-index offset img-index-max [
img-index: subtract img-index img-index-max
wraped: true
]
if wraped [
while [found? find pixels img-index] [img-index: img-index + 1]
]
]
]
return rc
]
encode-byte: func [
"Encodes a byte in the datastream."
val [integer!] "The byte to hide."
/group "no gap between encoded bits."
/local offset
] [
foreach bit enbase/base to string! to char! val 2 [
either zero? to integer! form bit [
set-even-color color-index
] [set-odd-color color-index ]
insert tail pixels img-index
either group [
if equal? color-index: add color-index // 3 1 1 [img-index: add img-index 1]
] [
offset: first key-index: wrap-next key-index
color-index: add offset // 3 1
if greater? img-index: add img-index offset img-index-max [
img-index: subtract img-index img-index-max
wraped: true
]
if wraped [
while [found? find pixels img-index] [img-index: img-index + 1]
]
]
]
]
encode-noise: func [
{Fügt zusätzliches Rauschen zur Verschleierung der Nachricht ins Bild ein.}
n [integer!] "Anzahl der Pixel, die verrauscht werden."
] [
loop n [
img-index: random img-index-max
either random false [
set-odd-color random 3
] [set-even-color random 3 ]
]
]
encode-msg: func [
"Verschlüsselt eine Nachricht im Datenstrom."
msg [series!] "Die zu codierende Nachricht."
key [series!] "Der symmetrische Schlüssel."
/local l hash stream cmsg
] [
cmsg: compress~ msg
l: length? msg
if lesser? l length? cmsg [cmsg: msg]
hash: get-key-chain key l: length? cmsg
stream: (nxor to binary! cmsg hash)
clear pixels
wraped: false
color-index: 1
key-index: head hash
img-index: 1
foreach element to-pixel/no-tuple l [encode-byte/group element ]
color-index: 1
foreach byte stream [encode-byte byte ]
head img
]
decode-msg: func [
"Extrahiert eine Nachricht aus dem Bild"
key [series!] "Der symmetrische Schlüssel."
/old "Kompatibilitäts-Modus"
/local hash l stream err
] [
clear pixels
wraped: false
color-index: 1
img-index: 1
stream: make binary! []
clear stream
l: from-pixel reduce [decode-byte/group decode-byte/group decode-byte/group]
either old [
hash: get-key-stream l key
key-index: head key
] [
hash: get-key-chain key l
key-index: head hash
]
loop l [insert tail stream to char! decode-byte ]
stream: nxor stream hash
either error? err: try [either all [equal? copy/part stream 2 64#{eJw=} equal? copy/part skip tail stream -2 2 64#{AAA=}] [decompress stream] [decompress~ stream]] [to string! stream ] [err ]
]
encrypt: func [
"enrypts the message in the image."
/local msg
] [
either none? img [
message/color [" E R R O R : " "Not able to encrypt the message !!!" "Please load an image first."] red
] [
either empty? smsg/text [
message/color/timeout [" A T T E N T I O N : " "No message to encrypt !!!" "Please enter your message first."] yellow 0:00:06
hide-popup
focus smsg
] [
either ulf [msg: copy smsg/text] [msg: join copy/part smsg/text min 50 to integer! multiply length? smsg/text 0.25 ["...<SNIP>" newline newline system/script/header/Name " DEMO-Version !!!"]]
either lesser? multiply length? msg 8 (divide img-index-max noise-ratio) - 8 [
if noise [encode-noise multiply length? msg noise-ratio]
crypt-img: encode-msg msg checksum/method pkey/text 'md5
] [
message/color [" E R R O R : " "Not able to encrypt this message !!!" "Please shorten it or load a larger image."] red
focus smsg
]
]
]
]
decrypt: func [
"decrypts a message from the image."
/old "Kompatibilitäts-Modus"
/local err
] [
either none? img [
message/color [" E R R O R : " "Not able to decrypt a message !!!" "Please load an image first!"] red
] [
either any [all [old not error? err: try [decode-msg/old checksum/method pkey/text 'md5]]
not error? err: try [decode-msg checksum/method pkey/text 'md5]] [
smsg/texts: reduce [smsg/text: copy err]
smsg/para/scroll: 0x0
show [smsg]
focus smsg
] [
message/color [" E R R O R : " "Not able to decrypt a message !!!" "Invalid image or wrong key!"] red
]
]
]
sendmail: layout [
styles btn-styles
backdrop effect bg-effect
vh2 reform ["Send email to" system/script/header/Name "author:"] bg-color + 80 with [feel: none]
msg: area "Type your message here ..." 250x60 bg-color + 80 wrap font [color: bg-color / 3] edge [color: e-color]
across return
btn 80 "Send" "Send ..." [
unfocus
sending: flash "Sending ..."
either error? try [
hdr: make system/standard/email [subject: reform [system/script/header/Name system/script/header/Version]]
send/header D.Weyand@TGD-Consulting.de msg/text hdr
] [
unview/only sending
message/color [" E R R O R :" "Error sending email !!!" "Check your REBOL network setup."] red
] [
unview/only sending
message/color/timeout [" O K A Y " "Your email has been sent!" "Thanx 4 Your message."] green 0:00:06
hide-popup
unview/only sendmail
]
] [
unfocus
sending: flash "Sending ..."
either error? try [
hdr: make system/standard/email [subject: reform [system/script/header/Name system/script/header/Version "(" user-prefs/name ")"]]
send/header D.Weyand@TGD-Consulting.de msg/text hdr
] [
unview/only sending
message/color [" E R R O R :" "Error sending email !!!" "Check your REBOL network setup."] red
] [
unview/only sending
message/color/timeout [" O K A Y " "Your email has been sent!" "Thanx 4 Your message."] green 0:00:06
hide-popup
unview/only sendmail
]
]
pad 82 btn 80 "Cancel" "Canceled" keycode [#"^["] [unfocus unview/only sendmail] [unfocus unview/only sendmail]
]
sendmail/feel: make sendmail/feel [
detect: func [face event /local rc] [
rc: true
switch event/type [
scroll-line [scroll-area false event/offset/y msg]
scroll-page [scroll-area true event/offset/y msg]
key [if found? face: find-key-face face event/key [
if get in face 'action [do-face face event/key]
rc: false
]
]
]
if rc [event]
]
]
history: layout [
size 350x150
styles btn-styles
backdrop effect bg-effect
across
banner "History ..." 308 bg-color + 80 with [feel: none] return
pad 0x-5 h-txt: text 294x80 bg-color / 3 bg-color + 80 no-wrap edge [color: e-color size: 2x2 effect: 'ibevel] with [feel: none]
pad -8x0 h-sld: slider h-txt/size/y * 0x1 + 16x0 bg-color / 3 bg-color / 2 edge [color: e-color] [scroll-slider-text h-txt h-sld]
at 0x0
key keycode [up page-up] [scroll-wheel true -1 h-txt h-sld]
key keycode [down page-down] [scroll-wheel true 1 h-txt h-sld]
key keycode [home] [scroll-wheel/end true -1 h-txt h-sld]
key keycode [end] [scroll-wheel/end true 1 h-txt h-sld]
at 328x3 small-btn "X" keycode [#"^["] [unview/only history] [unview/only history]
]
h-txt/text: system/script/header/History
either any [system/version > 1.3.0 link?] [h-sld/pane/1/edge/color: e-color] [h-sld/pane/edge/color: e-color]
scroll-slider-text h-txt h-sld
history/feel: make history/feel [
detect: func [face event /local rc] [
rc: true
switch event/type [
scroll-line [scroll-wheel false event/offset/y h-txt h-sld]
scroll-page [scroll-wheel true event/offset/y h-txt h-sld]
key [if found? face: find-key-face face event/key [
if get in face 'action [do-face face event/key]
rc: false
]
]
]
if rc [event]
]
]
about-box: layout [
size 342x275
styles btn-styles
backdrop effect bg-effect
banner "About ..." 300 bg-color + 80 with [feel: none]
pad 0x-5 panel 300x205 edge [size: 2x2 effect: 'ibevel color: e-color] [
style link text bold font [colors: reduce [0.0.0 (bg-color / 4)]]
backdrop (bg-color + 80) effect reduce ['gradient 0x1 (bg-color + 65) (bg-color + 80)]
origin 23
across
at 23x10
pa-hd1: h2 underline form system/script/header/Name (bg-color / 2.7) with [feel: none]
pa-hd2: h2 reform ["Version:" system/script/header/Version] (bg-color / 2.7) font [colors: reduce [(bg-color / 2.7) (bg-color / 4)]] [unfocus view/kf/new/options center-face history [no-title]] return
space 0
box 250x3 edge [size: 1x1 color: bg-color + 55 effect: 'bevel] return
credits: text (bg-color / 2.7) center bold no-wrap 250x80 rate 30 para [origin: 0x10]
feel [engage: func [face action event] [
if action = 'time [
face/para/origin: face/para/origin - 0x1
if lesser? second face/para/origin negate second size-text credits [face/para/origin: 0x70]
show face]
]
] return
space 8
box 250x3 edge [size: 1x1 color: bg-color + 55 effect: 'bevel] return
space 0
pad 15 text (bg-color / 2.7) bold "written by" with [feel: none]
link (bg-color / 2.5) system/script/header/Author [unfocus sendmail/offset: about-box/offset + 200x220 view/kf/new/options sendmail [no-title]] return
pad 15 text (bg-color / 2.7) bold reform ["Copyright" copydate ","] with [feel: none]
space 8 link (bg-color / 2.7) system/script/header/Rights [
unfocus
connect?
] return
pad 15 text (bg-color / 2.7) bold no-wrap reform ["Updated: " to-idate system/script/header/Date] with [feel: none] return
]
at 299x3
small-btn "?" keycode [#"?"] [view/kf/new/options center-face history [no-title]] [view/kf/new/options center-face history [no-title]]
at 320x3
small-btn "X" keycode [#"^["] [unview/only about-box] [unview/only about-box]
]
xsize: to integer! ((300 - (first pa-hd2/offset + first pa-hd2/size - first pa-hd1/offset)) / 2)
pa-hd2/offset: to pair! join xsize + first pa-hd2/offset - first
pa-hd1/offset ["x" second pa-hd2/offset]
pa-hd1/offset: to pair! join xsize ["x" second pa-hd1/offset]
show [pa-hd1 pa-hd2]
credits/text: {
- - - - - -
}
insert credits/text form system/script/header/Comment
insert credits/text reform [">>> " system/script/Header/Name " <<<" newline]
insert credits/text {
\|/
@ @
----------oOO-(_)-OOo----------
-= T G D =-
is proud to
present
}
either ulf [
insert tail credits/text reform ["This software is registered to" newline licensee "."]
if date? expiry [
insert tail credits/text reform [newline "Your license will expire at" newline expiry "!"]
]
] [
either all [value? 'expiry date? expiry] [insert tail credits/text reform ["This software has been registered to" newline licensee "," newline "but your license expired !" newline ]
] [
insert tail credits/text {This software is not registered yet
and runs in D E M O - mode only !
}
]
insert tail credits/text reform ["^/To register and run the full version of"
newline system/script/Header/Name {, contact TGD-Consulting
at the following email address :
info@TGD-Consulting.de}]
]
insert tail credits/text "^/^/- - - - - -"
lay-main: layout [
size 640x300
styles btn-styles
backdrop effect bg-effect
across
banner 600 farbe + 80 underline bold "Stegano-It!" with [feel: none] return
guide 280x50
pad 0x50 btn "Load" [unfocus display load-image] [unfocus display load-image] return
btn "Encrypt ->" [unfocus encrypt] [unfocus encrypt] return
btn "<- Decrypt" [unfocus decrypt] [unfocus decrypt/old] return
btn "Save" [unfocus save-image] [unfocus save-image] return
guide 20x50
at 20x50
vh4 240 farbe + 80 "Secret - Message" "copied to clipboard" center [
if not empty? smsg/text [write clipboard:// smsg/text]
] [
either empty? smsg/text [
smsg/text: read clipboard://
] [
foo: copy smsg/text
smsg/texts: reduce [smsg/text: read clipboard://]
write clipboard:// foo
]
show [smsg]
focus smsg
] return
pad 0x-6 smsg: area 240x170 farbe + 80 wrap font [color: farbe / 3] edge [size: 2x2 effect: 'ibevel color: e-color] "Type your secret message here ..." return
pad 0x-2 vh4 32 farbe + 80 "Key" no-wrap center with [feel: none]
pkey: field farbe + 80 font [color: farbe / 3] edge [size: 2x2 effect: 'ibevel color: e-color] "Enter your private-key here ..."
guide 380x50
at 380x50
vh4 240 farbe + 80 "Thumb - Image" center with [feel: none] return
pad 0x-6 panel 240x200 farbe / 2 edge [size: 2x2 effect: 'ibevel color: e-color] [
origin 0x0
space 0x0
pnl-img: box 240x200 farbe / 2 "No Picture!" font [color: farbe + 80]
] return
pad -360x1 text 600 center farbe + 80 no-wrap join "(c) " [copydate " " system/script/header/Rights] with [feel: none] [connect?] [connect?]
key keycode [#"?"] [if not hot-key-wrapped? #"?" [view/new/offset/title about-box (lay-main/offset + 590x37) join "about " system/script/header/Name]]
at 618x3
small-btn "X" keycode [#"^["] [
if confirm reform ["Do you really want to quit" system/script/title "?"] [shutdown]
] [
if confirm reform ["Do you really want to quit" system/script/title "?"] [shutdown]
]
at 597x3
small-btn "?" [view/new/offset/title about-box (lay-main/offset + face/offset + face/size + -50x15) join "about " system/script/header/Name] [view/new/offset/title about-box (lay-main/offset + face/offset + face/size + 20x60) join "about " system/script/header/Name]
]
lay-main/feel: make lay-main/feel [
detect: func [face event /local rc] [
rc: true
switch event/type [
scroll-line [scroll-area false event/offset/y smsg]
scroll-page [scroll-area true event/offset/y smsg]
key [if found? face: find-key-face face event/key [
if get in face 'action [do-face face event/key]
rc: false
]
]
close [rc: false
either confirm reform ["Do you really want to quit" system/script/title "?"] [shutdown] [view/kf/new lay-main]]
]
if rc [event]
]
]
if ulf [load-config config-file]
either main-offset [lay-main/offset: main-offset] [center-face lay-main]
view/kf lay-main
shutdown
