27089 total geeks with 3528 solutions
Recent challengers:
 Welcome, you are an anonymous user! [register] [login] Get a yourname@osix.net email address 

Articles

GEEK

User's box
Username:
Password:

Forgot password?
New account

Shoutbox
timsattemme
<ul><li><str ong><a href="http:/ /www.ywjx8.c om/">cheap wedding dresses</a>< /strong> </l i><li><stron g><a href="http:/ /www.ywjx8.c om/">Sexy Beach Wedding Dresses Sale</a></st rong> </li>< li><strong>< a href="http:/ /www.ywjx8.c om/">cheap wedding dresses</a>< /st
timsattemme
[b][url=http ://www.watch esiphone5.co m/]replica o<strong><a href="http:/ /www.watches iphone5.com/ ">replica omega watches</a>< /strong> <br > <strong><a href="http:/ /www.watches iphone5.com/ ">replica cartier watches</a>< /strong> <br >
timsattemme
<strong><a href="http:/ /www.watches iphone5.com/ ">cartier watches</a>< /strong> | <strong><a href="http:/ /www.watches iphone5.com/ ">rolex watches</a>< /strong> | <strong><a href="http:/ /www.watches iphone5.com/ ">omega watches</a>< /strong> <br > <title>Longi
timsattemme
[b][url=http ://www.copyr olexdaytona. com/]rolex new 2013[/url][/ b] [b][url=h ttp://www.co pyrolexdayto na.com/]role x basel[/url][ /b] [b][url=http ://www.copyr olexdaytona. com/]rolex Y<br><strong ><a href="http:/ /www.copyrol exdaytona.co m/">rolex new 2013</a></st
timsattemme
<br><strong> <a href="http:/ /www.copyrol exdaytona.co m/">rolex new 2013</a></st rong> <stron g><a href="http:/ /www.copyrol exdaytona.co m/">rolex basel</a></s trong> <br>< strong><a href="http:/ /www.copyrol exdaytona.co m/">rolex Yacht-Master II</a></stro ng> <br><b

Donate
Donate and help us fund new challenges
Donate!
Due Date: Oct 31
October Goal: $40.00
Gross: $0.00
Net Balance: $0.00
Left to go: $40.00
Contributors


News Feeds
The Register
SKYPE has the HOTS
for my NAKED WIFE
Time to test your
sarcasm detectors:
It"s the UN"s
global comms
shakeup
extravaganza!
Wanna see how
Russia et al hope
to shape the
internet? ITU opens
up (a little more)
t
Google CEO Larry
Page gives Sundar
Pichai keys to the
kingdom
Cheapo telcos fined
for their cheapo
security: Financial
records on 305,000
people spill
LG taps TSMC to
bake its first-ever
mobile chip
FCC: You"ll have to
wait even longer
for faster wireless
broadband
Breaking news:
Google exec in
terrifying SKY
PLUNGE DRAMA
Revealed: The
amazing magical
innovation in the
iPad Mini 3 ? a
lick of paint
Silicon Valley
scrooges paid staff
$1.21 an hour in a
122-hour week
Slashdot
Peter Kuran:Visual
Effects Artist and
Atomic Bomb
Archivist
OwnCloud Dev
Requests Removal
From Ubuntu Repos
Over Security Holes
Microsoft Now Makes
Money From Surface
Line, Q1 Sales
Reach Almost $1
Billion
Days After
Shooting, Canada
Proposes New
Restrictions On and
Offline
AT&T Locks
Apple SIM Cards On
New iPads
Passwords: Too Much
and Not Enough
Verizon Injects
Unique IDs Into
HTTP Traffic
Secretive Funding
Fuels Ongoing Net
Neutrality
Astroturfing
Controversy
A Low Cost, Open
Source Geiger
Counter (Video)
Computer Scientist
Parachutes From
135,908 Feet,
Breaking Record
Article viewer

Yet another Qbasic example



Written by:dimport
Published by:dimport
Published on:2003-06-21 07:19:46
Topic:Miscellaneous
Search OSI about Miscellaneous.More articles by dimport.
 viewed 10616 times send this article printer friendly

Digg this!
    Rate this article :
Here is an encryption program that i made in Q basic. I basically compiled some prog's i found on the internet.


SCREEN 2: SCREEN 0: CLS

Menu:

LOCATE 1, 15: PRINT "CRYPTOR v1.0"

LOCATE 2, 15: PRINT "by ADAM PERRY & MATT OCHS"

LOCATE 3, 13: PRINT " Main Menu "

LOCATE 5, 10: PRINT "E]ncrypt message"

LOCATE 7, 10: PRINT "D]ecrypt message"

LOCATE 9, 10: PRINT "Q]uit Cryptor"

Loop1:

GOSUB GetKey: IF A$ = "E" THEN GOTO Encrypt ELSE IF A$ = "D" THEN GOTO Decrypt ELSE IF A$ = "Q" THEN GOTO Quit ELSE GOTO Loop1

GetKey:

A$ = UCASE$(INKEY$): IF A$ = "" THEN GOTO GetKey

RETURN

Encrypt:

CLS

PRINT "All information except for the file name is capitalization-snsitive."

PRINT "This means that capitalization will affect the message."

INPUT "Recipiant name"; N$

INPUT "File name"; F$

INPUT "Encrypt code"; C$

CLS

INPUT "Message text: ", M$

OPEN F$ + ".CPT" FOR OUTPUT AS #1

A = 0: B = 0: C = 0: CR$ = ""

DO WHILE A LEN(N$) THEN B = 1

C = C + 1: IF C > LEN(C$) THEN C = 1

D = ASC(MID$(M$, A, 1)) + ASC(MID$(N$, B, 1)) + ASC(MID$(C$, C, 1))

Loop2:

IF D > 255 THEN D = D - 255: GOTO Loop2

CR$ = CR$ + CHR$(D)

LOOP

WRITE #1, CR$: CLOSE

CLS : GOTO Menu:

Decrypt:

CLS

PRINT "All information exept the file name is capitalization-sensitive."

PRINT "This means that capitalization will affect the message."

INPUT "Recipiant name"; N$

INPUT "File name"; F$

INPUT "Encypt code"; C$

CLS : CR$ = ""

OPEN F$ + ".CPT" FOR INPUT AS #1

INPUT #1, CR$

CLOSE

A = 0: B = 0: C = 0: M$ = ""

DO WHILE A LEN(N$) THEN B = 1

C = C + 1: IF C > LEN(C$) THEN C = 1

D = ASC(MID$(CR$, A, 1)) - (ASC(MID$(N$, B, 1)) + ASC(MID$(C$, C, 1)))

Loop3:

IF D < 1 THEN D = D + 255: GOTO Loop3

M$ = M$ + CHR$(D)

LOOP

Menu2:

CLS

LOCATE 1, 15: PRINT "Cryptor v1.0"

LOCATE 2, 15: PRINT "by ADAM PERRY & MATT OCHS"

LOCATE 3, 13: PRINT "Decryption Complete"

LOCATE 5, 10: PRINT "V]iew message"

LOCATE 7, 10: PRINT "S]ave message"

LOCATE 9, 10: PRINT "Main menu"

Loop4:

GOSUB GetKey: IF A$ = "V" THEN GOTO ViewMessage ELSE IF A$ = "S" THEN GOTO Save

IF A$ = "M" THEN GOTO Menu ELSE GOTO Loop4

ViewMessage:

CLS : PRINT M$: GOSUB GetKey: GOTO Menu2

Save:

OPEN F$ + ".TXT" FOR OUTPUT AS #1

WRITE #1, M$

CLOSE : GOTO Menu2

Quit:

CLS : SYSTEM




Well, thats it.

This article was originally written by Apocolipse

Did you like this article? There are hundreds more.

Comments:
Anonymous
2007-10-11 21:25:37
You stringed all your variables wrong, A LEN is also incorrect. If you tried to run it, it would not work, 100% about that. Nice try though.
Anonymously add a comment: (or register here)
(registration is really fast and we send you no spam)
BB Code is enabled.
Captcha Number:


Blogs: (People who have posted blogs on this subject..)
Action
First one on Tue 12th Jan 10pm
Yaw, this is the first blog post, just to begin with something. Nice site here, cool features like OSIDrive, and so on. However, strange that an "OpenSource Institute" uses non-OpenSource softare to host its site (Windows and IIS). It's not correct... I t
bb
A Daily Profanity at dailyprofanity.com on Mon 21st Dec 11am
For anyone who likes viz, and roger mellies profanisaurus. There's a website called amusing daily profanity which dishes up a humorous profanity every day via rss, twitter email and a few other ways. Rather rude words, but very funny in my opinion,
hambone
Blog entry for Wed 25th Nov 7pm on Wed 25th Nov 7pm
wtf i can't do geek 12. I don't know what to do. i want to kill myself becuz of this
haziman
Blog entry for Mon 9th Nov 4am on Mon 9th Nov 4am
for all geekos out there...
echmil
fuck you all!!!!!!!! on Sat 7th Nov 11pm
goldie
Blog entry for Tue 5th May 6am on Tue 5th May 6am
import javax.mail.*; import javax.mail.internet.*; import javax.activation.*; import java.io.*; import java.util.Properties; public class SENDMAIL { public void sendMail(String mailServer, String from, String to,
bb
Bubble Graph on Wed 11th Mar 12pm
I love this graph bubble graph http://www.osix.net:80/modules/folder/in dex.php?tid=28125&action=vf
ketan404
My online resume! on Mon 9th Mar 8am
It is here http://www.listoffreelancers.com/profile s/ketankulkarni Simple and clean design. I like this website. Ketan
macrocat
Blog entry for Sun 8th Mar 3pm on Sun 8th Mar 3pm
Another site with some challenges. Basically, I'm linking this to get a measly five points ;O. Hellbound Hackers
Nightscript
Parapsychology - Fri 19th Dec 5am on Fri 19th Dec 5am
Yes i'm crazy but heres what ive been thinking about and it seems more reasonable that a lot of reality. Note that this ties into parapsychology/psychokinesis research. Mind is not over matter. Thats the wrong state of thinking for sure. Look, this


     
Your Ad Here
 
Copyright Open Source Institute, 2006