Posts: 2,765
Threads: 138
Joined: Nov 2002
zack: yup i noticed that after i posted.
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Posts: 3,343
Threads: 83
Joined: Mar 2003
I wrote this ages ago for something on this forum, it uses a key, which you can change or whatever. It just shows how keys can be used, try it with a key that's 5000 chars long
Code: ' -- Encryption Program --
' - By The Oracle -
' This program takes an inputted string and encodes it to a file. You can
' also use this program to decode. It is based on a simple encoding
' technique, "using a keyword". Basically even if the numbers in the file
' are the same they could be two different letters because every letter
' is encoded differently.
DECLARE SUB getkeywords ()
DIM SHARED keywords(1 TO 5) AS STRING
RANDOMIZE TIMER
getkeywords
CLS
LOCATE 10, 15
COLOR 9
PRINT "Welcome to The Oracle's Encryption Program"
LOCATE 12, 25
COLOR 15
PRINT "1) Encrypt message"
LOCATE 13, 25
PRINT "2) Decrypt message"
LOCATE 14, 25
PRINT "3) Exit"
LOCATE 16, 25
INPUT "Your choice? ", choice$
IF choice$ = "1" THEN
GOTO encryption
ELSEIF choice$ = "2" THEN
GOTO decryption
ELSEIF choice$ = "3" THEN
END
ELSEIF choice$ = CHR$(27) THEN
END
ELSE
RUN
END IF
' I wouldn't normally use GOTO, but you can't redim arrays when inside
' subroutines as far as I am aware... Anyone know how???
encryption:
CLS
k = INT(RND * 5) + 1
FOR a = 1 TO LEN(keywords(k))
codes(a) = ASC(MID$(keywords(k), a, 1)) ' Store the ASCII codes in an array
NEXT a
INPUT "Type a string you want to encrypt: ", encrypt$
IF encrypt$ = CHR$(27) THEN END
INPUT "Type a name for the file the info is stored in: ", filename$
IF filename$ = CHR$(27) THEN END
IF RIGHT$(filename$, 4) <> ".txt" THEN filename$ = filename$ + ".txt"
DIM SHARED enc(1 TO LEN(encrypt$)) AS INTEGER
OPEN filename$ FOR OUTPUT AS #1
FOR b = 1 TO LEN(encrypt$) ' For each character
IF b > LEN(keywords(k)) + c THEN c = c + LEN(keywords(k)) ' If the character
' number is greater
' than the keyword
' start from the
' start of the keyword
enc(b) = ASC(MID$(encrypt$, b, 1)) + codes(b - c) ' This is simple encoding
PRINT #1, STR$(enc(b)) ' Print to file
NEXT b
CLOSE
PRINT "Your key is"; k; ". Don't lose it!!!"
WHILE INKEY$ = "": WEND
RUN
decryption:
CLS
INPUT "Enter your keycode: ", k
INPUT "Enter the filename: ", filename$
IF RIGHT$(filename$, 4) <> ".txt" THEN filename$ = filename$ + ".txt"
OPEN filename$ FOR INPUT AS #1
DO UNTIL EOF(1) ' This loop simply counts the number of lines
INPUT #1, a$
d = d + 1
LOOP
CLOSE ' How do you reposition the cursor at the beginning of a file?
' I've used CLOSE and OPEN
OPEN filename$ FOR INPUT AS #1
DIM decodes(1 TO d) AS INTEGER ' Array for storing the codes from the file
FOR o = 1 TO d ' Get the numbers in the file
INPUT #1, a%
decodes(o) = a%
NEXT o
FOR a = 1 TO LEN(keywords(k)) ' Get the codes of the keyword
codes(a) = ASC(MID$(keywords(k), a, 1))
NEXT a
DIM SHARED enc(1 TO d) AS INTEGER ' Array for the actual message
FOR l = 1 TO d
IF l > LEN(keywords(k)) + c THEN c = c + LEN(keywords(k))
enc(l) = decodes(l) - codes(l - c) ' Decode the string
PRINT CHR$(enc(l)); ' Print the result
NEXT l
WHILE INKEY$ = "": WEND
RUN
END
SUB getkeywords
keywords(1) = "roast"
keywords(2) = "qbasic"
keywords(3) = "mouse"
keywords(4) = "oracle"
keywords(5) = "algorithm"
END SUB
Posts: 3,616
Threads: 287
Joined: Jan 2003
You most certainly can REDIM inside SUBs. Well, in QB4.5, that is, don't know about earlier versions.
[EDIT]OK, this works...
Code: DIM blah(1) AS INTEGER
SUB blahblah
REDIM blah(1) AS INTEGER
END SUB
Just make sure that you initially DIM blah to have a subscript, I.e. you can just say "DIM blah AS INTEGER".
f only life let you press CTRL-Z.
--------------------------------------
Freebasic is like QB, except it doesn't suck.
Posts: 3,343
Threads: 83
Joined: Mar 2003
Can you??? I can't do it with my current project...
Posts: 3,616
Threads: 287
Joined: Jan 2003
Try running that code within QB 4.5...
Oh yeah, and place '$DYNAMIC at the top.
[EDIT]And of course, it won't preserve the values.
[EDIT2]And chatting on IRC with Joakim, he informed me that you CAN preserve values...but only in QB 7.1....by doing REDIM PRESERVE arrayName(nSubscripts) AS type
f only life let you press CTRL-Z.
--------------------------------------
Freebasic is like QB, except it doesn't suck.
Posts: 1,845
Threads: 44
Joined: Aug 2002
You can implicitly preserve the values though...
Here:
Code: '$DYNAMIC
DEFINT A-Z
CONST INDEXSIZE = 2
DIM MyArray(10) AS INTEGER
'fill the array
FOR I = LBOUND(MyArray) TO UBOUND(MyArray)
MyArray(I) = INT(RND * 100)
NEXT I
'now copy the array
DIM Temp(LBOUND(MyArray) TO UBOUND(MyArray)) AS INTEGER
size% = ((UBOUND(MyArray) - LBOUND(MyArray)) + 1) * INDEXSIZE
FOR I = 0 TO size% - 1
DEF SEG = VARSEG(MyArray(0))
byte% = PEEK(VARPTR(MyArray(0)) + I)
DEF SEG = VARSEG(Temp(0))
POKE VARPTR(Temp(0)) + I, byte%
NEXT I
'resize other
REDIM MyArray(12) AS INTEGER
'copy again
size% = (UBOUND(Temp) - LBOUND(Temp)) + 1
FOR I = 0 TO size% - 1
DEF SEG = VARSEG(Temp(0))
byte% = PEEK(VARPTR(Temp(0)) + I)
DEF SEG = VARSEG(MyArray(0))
POKE VARPTR(MyArray(0)) + I, byte%
NEXT I
I haven't tested but theorethically it should work I think
Posts: 3,616
Threads: 287
Joined: Jan 2003
A little simpler to use the PRESERVE option, I think? :wink:
f only life let you press CTRL-Z.
--------------------------------------
Freebasic is like QB, except it doesn't suck.
Posts: 358
Threads: 15
Joined: May 2003
Well...I started this in QBasic, but then decided to learn C++ instead...
Here's the latest iteration...fixed a bug today.
http://home.bellsouth.net/p/PWP-brightwave
This prog authenticates the files and keeps track of original filename in encrypted form.
It's a console app in the true QB spirit...
EDIT:: I forgot to mention...to use the program, just "drop" the file to be encrypted onto the executable. Piece of cake.
Posts: 115
Threads: 6
Joined: Feb 2003
Zack: the PRESERVE option isn't availible in 4.5 at least it isn't in my copy. Pisses me off, had to write my own routines for it
very F***ing song remains the same
To everyone who sucks-up for the fame
Out of strength you know we speak the truth
Every trend that dies is living proof
MasterMinds Software
Posts: 1,956
Threads: 65
Joined: Jun 2003
mikkeey123,
I just sent you my time-proven encryption utility program to you email address. I only sent the executable because the QuickBasic source code uses functions from the QuickPak Professional library.
Try it, you'll like it!
*****
|