Yksinkertainen salakieli

[temu92]

Englanninkielentunnilla tuli väsättyä todella yksinkertainen salakieli ja pitihän tottakai väsätä versio tietokoneellekkin. Joten tässä olisi

Selitys miten toimii:
Ensin on kaikki kirjaimet jotka ovat salauksen avain luetellaan tyyliin

Code: Select all

ABCDEFG|HIJKLMN|OPQRSTU|VXYZÅÄÖ

HUOM!! W tarkoituksella poissa jotta jako 7 osissa onnistuu, tosin sen olisi saanut pienellä vaivalla paremmaksikin mutta se jääköön teille kotitehtäväksi

Sitten otetaan vaikka sana talo
Jotta se saadaan käännettyä salakieleen tarkastellaan jokaista kirjainta

Code: Select all

T - Löytyy OPQRSTU, se on 6. kirjain. Otetaan seuraava kirjainyhdistelmä joka on VXYZÅÄÖ ja napataan sieltä kirjain Ä
Homma jatkuu vastaavasti tosin jos otetaan kirjain viimeisestä yhdistelmästä tarkasteltavaksi, salakoodattu otetaan ensimmäisestä ja päinvastoin.

Ja jotta saisit koodin purettua, tee sama homma täysin päinvastoin eli jos kirjain on otettu VXYZÅÄÖ, oikeakielinen otetaan OPQRSTU

Joten nyt sana TALO muuttuu ÄHSV
Testatkaa itse, tällä saat väsättyä hauskoja pulmia aivonystyröiden kiusaamiseen

Code: Select all

SCREEN 800, 200
Const CODE_ENCODE = 1
Const CODE_DECODE = -1

Const KEYWORD_COUNT = 3
Dim keyword(KEYWORD_COUNT) As String
keyword(0)="abcdefg"
keyword(1)="hijklmn"
keyword(2)="opqrstu"
keyword(3)="vxyzåäö" // W on tarkoituksella poissa koska ei niin yleinenkään kirjain

Repeat
	txt$ = Input("Write something >> ")
	If show Then
		Text 10, 20, "Original: "+orgtxt$
		Text 10, 45, "Encoded: "+encodedtxt$
		Text 10, 60, "Decoded: "+decodedtxt$
	EndIf
	If KeyHit(28) Then
		orgtxt$ = txt$
		encodedtxt$ = EncodeTxt(txt$)
		decodedtxt$ = DecodeTxt(txt$)
		show = 1
		CloseInput
	EndIf
	DrawScreen
Forever

Function EncodeTxt(txt$)
	Return CodeTxt(txt$, CODE_ENCODE)
EndFunction

Function DecodeTxt(txt$)
	Return CodeTxt(txt$, CODE_DECODE)
EndFunction

Function CodeTxt(txt$, codingStyle)
	txt$ = Lower(txt$)
	For i=1 To Len(txt$)
		letter$ = Mid(txt$, i, 1)
		If IsLetter(letter$) Then
			For x=0 To 3
				letterID = InStr(keyword(x), letter$)
				If letterID > 0 Then
					keywordID = CalcKeywordID(x, codingStyle)
					newLetter$ = Mid(keyword(keywordID), letterID, 1)
					newtxt$ = newtxt$ + newLetter$
					Exit
				EndIf
			Next x
		Else
			newtxt$ = newtxt$ + letter$
		EndIf
	Next i
	Return newtxt$
EndFunction

Function IsLetter(letter$)
	letter$ = Lower(letter$)
	ascCode = Asc(letter$)
	If (ascCode >= 97 And ascCode <= 122) Or (ascCode = 228 Or ascCode = 246 Or ascCode = 229) And ascCode <> 119 Then //poista kohta And ascCode <> 119 jos haluat myös W toimivan
		Return 1
	EndIf
	Return 0
EndFunction

Function CalcKeywordID(curID, codingStyle)
	newID = curID + codingStyle
	If newID < 0 Then Return KEYWORD_COUNT
	If newID > KEYWORD_COUNT Then Return 0
	Return newID
EndFunction

[TheDuck]

Whö! Äffofu vu ävåp opluv =x Uötlzvä avpå aplsf ävptph =)

Suomennos: Wau! täähän on tosi hieno =P Numerot vois vielä toimia =)

Oli pakko testata...

[temu92]

Numerot vois vielä toimia =)

Ne voit itse lisätä helposti lisäämällä rivejä tohon keywordiin

[Purple]

Kiva

[Bagard]

Kiva

Attention:

Ei juma. Tällaisia viestejä ei sitten enää jatkossa postata ollenkaan. Tämä on sentään foorumi, joten kyllä niissä viesteissä pitää olla sisältöäkin!

[Vipix]

Kiva on.
Tietäiskö kukaan millä koodilla ton koodin sais purettua?

[Vipix]

Tai sellasen, että vois kopioida tekstin, suoraan Ctrl + C
Oon näissä koodiasioissa peukalo keskellä kämmentä.

[temu92]

Siinähä koodis on jo decrypteri valmiina joten ei tartte mitää erillisii enää kehitellä. Ja leikepöytäkomennot löytyy täältä http://www.coolbasic.com/oldforums/inde ... c=2325&hl=

[elmo123]

Siinähä koodis on jo decrypteri valmiina joten ei tartte mitää erillisii enää kehitellä. Ja leikepöytäkomennot löytyy täältä http://www.coolbasic.com/oldforums/inde ... c=2325&hl=

1. Koodin decrypteri ei minulla ainakaan toiminut, salatusta tekstistä tuli pahempaa sotkua
2. Offtopic:Leikepöytäkomentojen latauslinkki ei toiminut