Qbasicnews.com

Pages: 1 2 3

zack: yup i noticed that after i posted.

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 Wink

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

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".

Can you??? I can't do it with my current project...

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

You can implicitly preserve the values though... Wink

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 Wink

A little simpler to use the PRESERVE option, I think? :wink:

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.

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 Tongue

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!
*****

Pages: 1 2 3

whitetiger0990

oracle

Zack

oracle

Zack

Neo

Zack

Mango

BinarySHOCK

Moneo