J5dYdfYh

1Red [needs: 'view]
2
3CRLF: copy "^M^/" ;; constant for 0D 0A line feed
4;;------------------------------------
5crypt: func ["function to en- or decrypt message from textarea tx1"
6    /decrypt "decrypting switch/refinement" ][ 
7;;------------------------------------
8
9;; when decrypting we have to remove the superflous newlines
10;; and undo the base64 encoding first ...
11txt: either decrypt [     ;; message to en- or decrypt
12   s: copy tx1/text
13   ;; newline could be single 0a byte or crlf sequence when copied from clipboard...
14   debase replace/all s either find s CRLF  [CRLF ] [ newline ] ""
15] [
16    tx1/text ;; plaintext message
17]
18
19txt: to-binary txt          ;; handle message as binary
20key: to-binary key1/text  ;; handle key also as binary
21
22bin: copy either decrypt [  ""  ][ #{} ] ;; buffer for output
23
24code: copy #{} ;; temp field to collect utf8 bytes when decrypting
25
26;; loop over  length of binary! message ...
27repeat pos length? txt [
28 k: to-integer key/(1 + modulo pos length? key)   ;; get corresponding key byte 
29 c: to-integer to-binary txt/:pos       ;; get integer value from message byte at position pos
30 
31 either decrypt [                         ;; decrypting ? 
32    c:  modulo ( 256 + c - k ) 256      ;; compute original byte value
33    case [
34      ;; byte starting with 11.... ( >= 192 dec ) is utf8 startbyte
35      ;; byte starting with 10... ( >= 128 dec) is utf8 follow up byte , below is single ascii byte
36        ( c >= 192 ) or ( c < 128 )  [    ;; starting utf8 sequence byte or below 128 normal ascii ?
37            ;; append last code to buffer, maybe normal ascii or utf8 sequence...
38            if not empty? code [ append bin to-char code ]  ;; save previous code first
39            code: append copy #{} c     ;; start new code 
40        ]
41        true [ append code c ]  ;; otherwise utf8 follow up byte, append to startbyte
42      ]
43  ][  
44    append bin modulo ( c + k ) 256   ;; encrypting , simply collect binary bytes
45  ]
46] ;; close repeat loop
47
48either decrypt [                ;; collect utf-8 characters
49   append bin to-char code    ;; append last code
50  tx2/text: to-string bin      ;; create valid utf8 string when decrypting
51][  ;; base64 encoding of crypted binary to get readable text string...
52    s: enbase copy  bin      ;; base 64 is default
53    while [40 < length? s ] [ ;; insert newlines for better "readability"
54        s: skip s either head? s [40][41]   ;; ... every 40 characters
55        insert s newline
56    ]
57    tx2/text: head s    ;; reset s pointing to head again
58  ]  
59]
60;----------------------------------------------------------
61; start of program
62;----------------------------------------------------------
63view layout [title  "vignere cyphre"	;Define nice GUI :- )
64;----------------------------------------------------------
65  backdrop silver
66  text "message:" pad 99x1 button "get-clip" [tx1/text: read-clipboard]
67  ;; code in brackets will be executed, when button is clicked:
68  button "clear" [tx1/text: copy "" ] return  
69  tx1: area  330x80 "" return
70  text 25x20  "Key:" key1:  field 290x20 "secretkey" return 
71  button "crypt" [crypt ]  button "decrypt" [crypt/decrypt ]
72  button "swap" [tx1/text: copy tx2/text tx2/text: copy "" ] return
73  text "de-/encrypted message:" pad 50x1  button "copy clip"  [ write-clipboard tx2/text] 
74  button "clear" [tx2/text: copy "" ] return
75  tx2: area  330x100 return
76  pad 270x1 button "Quit " [quit]
77]