home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ktencode / qbasic.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  6.4 KB  |  239 lines
  1. 'This function has been modified to work with QBasic.  Because of many
  2. 'features not supported in QBasic, namely PROCEDURE level ON ERROR
  3. 'handling, the 'FORCE' feature is unavailable (see READTHIS.TXT for
  4. 'info on 'FORCE' option).  This Function was originally designed for
  5. 'VISUAL BASIC for WINDOWS 3.0 and was modified to QBasic.  That means
  6. 'There may be strange looking stuff becasue I just changed things to
  7. 'to work and did not redesign it.  The 'FORCE' feature can be implemented
  8. 'but requires more work than I want to put into it right now.  Feel free
  9. 'to do it yourself if it is neccessary.
  10.  
  11. 'This is just a simple DEMO program to try the Function.  Have Fun!
  12. 'Programmed by Karl D Albrecht     KARL25@AOL.COM
  13. 'Please read the READTHIS.TXT file!
  14. 'Thank you
  15.  
  16.  
  17. DECLARE FUNCTION KTEncrypt$ (password$, original$, Flag%, Errors$)
  18. CLS
  19. Msg$ = "Hello, this is a test string to scramble."
  20.  
  21. CommandLoop:
  22.  
  23. CLS
  24. PRINT Msg$
  25. PRINT : PRINT : PRINT : PRINT : PRINT : PRINT
  26. PRINT STRING$(80, "-");
  27. LINE INPUT "PASSWORD:"; password$
  28. PRINT "0 - Encode  or  1 - Decode"
  29. OK = 0
  30. DO WHILE OK = 0
  31.   a$ = INKEY$
  32.   IF a$ = "1" OR a$ = "0" THEN OK = 1
  33. LOOP
  34. which% = VAL(a$)
  35.  
  36. Msg$ = KTEncrypt$(password$, Msg$, which%, Errors$)
  37. IF Errors$ <> "" THEN
  38.   BEEP
  39.  
  40.   PRINT : PRINT : PRINT "            " + Errors$
  41.   PRINT : PRINT " Press any key"
  42.   a$ = INPUT$(1)
  43. END IF
  44.  
  45. GOTO CommandLoop
  46.  
  47. Function KTEncrypt$ (password$, original$, Flag%, Errors$)
  48.  
  49.   'Dimension the Adjust array
  50.   ReDim Adjust(4)
  51.  
  52.   'Set strng$ to original so original is unaffected
  53.   'QBasic does not support ByVal
  54.   'We want to change strng$ but not original
  55.   strng$ = original$
  56.  
  57.   'Make sure Errors$=""
  58.   Errors$ = ""
  59.  
  60.  
  61.   'Check for errors (Errorcodes are custom)
  62.   'Is there Password??
  63.   If Len(password$) = 0 Then Errors$ = "NO PASSWORD!"
  64.  
  65.   'Is there a strng$ to work with?
  66.   If Len(strng$) = 0 Then Errors$ = "NO STRING!"
  67.  
  68.   'Check to see if it is an encoded file
  69.   If Right$(strng$, 5) = String$(5, 255) Then
  70.     'if encoding warn!
  71.     If Flag% = 0 Then Errors$ = "FILE ALREADY ENCODED!"
  72.   Else
  73.     'If decoding warn
  74.     If Flag% <> 0 Then Errors$ = "FILE NOT ENCODED!"
  75.   End If
  76.  
  77.   'If an error then exit
  78.   If Errors$ <> "" Then
  79.     KTEncrypt$ = original$
  80.     Exit Function
  81.   End If
  82.  
  83.  
  84.   'Create a four part encryption code based on password
  85.   'First Adjust code based on length of password
  86.   Adjust(1) = Len(password$)
  87.  
  88.   'If first character ascii code even make adjust negative
  89.   If Asc(Left$(password$, 1)) / 2 = Int(Asc(Left$(password$, 1)) / 2) Then
  90.     Adjust(1) = Adjust(1) * -1
  91.   End If
  92.  
  93.   'Second Adjust code based on first and last character ascii codes
  94.   Adjust(2) = Asc(Left$(password$, 1)) - Asc(Right$(password$, 1))
  95.  
  96.   'Third code based on average of all ascii codes
  97.   TotalAscii = 0
  98.   For Looper = 1 To Len(password$)
  99.     TotalAscii = TotalAscii + Asc(Mid$(password$, Looper, 1))
  100.   Next Looper
  101.   Adjust(3) = Int(TotalAscii / Len(password$) / 3)
  102.  
  103.   'Fourth code based on previous three
  104.   Adjust(4) = Adjust(1) + Adjust(2) + Adjust(3)
  105.  
  106.  
  107.  
  108.   'Now check if any Adjust codes are zero
  109.   'If it is zero make it not zero (any number is fine!)
  110.   For Looper = 1 To 4
  111.     If Adjust(Looper) = 0 Then Adjust(Looper) = Looper + Len(password$)
  112.   Next Looper
  113.  
  114.  
  115.   'Now check if any adjusts are the same
  116.   NotYet% = 1
  117.   Do While NotYet%
  118.     NotYet% = 0
  119.     For Loop1 = 1 To 4
  120.       For Loop2 = 1 To 4
  121.         'Don't compare same items
  122.         If Loop1 <> Loop2 Then
  123.          
  124.           'Check for a match
  125.           If Adjust(Loop1) = Adjust(Loop2) Then
  126.             Adjust(Loop2) = Adjust(Loop2) + Len(password$)
  127.            
  128.             'Make sure we didn't make it zero
  129.             If Adjust(Loop2) = 0 Then Adjust(2) = Adjust(Loop2) + Len(password$)
  130.            
  131.             NotYet% = 1
  132.           End If
  133.  
  134.         End If
  135.       Next Loop2
  136.     Next Loop1
  137.   Loop
  138.  
  139.  
  140.  
  141.  
  142.   'Encode or deocde
  143.   Counts = 0: Looper = 0
  144.  
  145.   'Loop until scanned though the whole file
  146.   Do While Looper < Len(strng$)
  147.    
  148.     'Add to Looper
  149.     Looper = Looper + 1
  150.  
  151.     'Keep Adjust code Counts from 1 to 4
  152.     Counts = Counts + 1
  153.     If Counts = 5 Then Counts = 1
  154.    
  155.     'Get the character to change
  156.     ToChange = Asc(Mid$(strng$, Looper, 1))
  157.    
  158.     'ENCODE   Flag%=0
  159.     If Flag% = 0 Then
  160.      
  161.       'If adjustment to high or low then reverse the coding and
  162.       'add in a chr$(255) to mark the change
  163.       If ToChange - Adjust(Counts) < 1 Or ToChange - Adjust(Counts) > 254 Then
  164.        
  165.         Addin$ = Chr$(255) + Chr$(ToChange + Adjust(Counts))
  166.         strng$ = Left$(strng$, Looper - 1) + Addin$ + Mid$(strng$, Looper + 1)
  167.         Looper = Looper + 1
  168.      
  169.       'If adjustment OK then just cahnge the character
  170.       Else
  171.        
  172.         Mid$(strng$, Looper, 1) = Chr$(ToChange - Adjust(Counts))
  173.  
  174.       End If
  175.  
  176.     'DECODE  Flag% <> 0
  177.     Else
  178.      
  179.       'If find a CHR$(255) then remove it and set Flag255% to
  180.       'ensure reverse codes on next pass reverse coding
  181.       If ToChange = 255 Then
  182.        
  183.         strng$ = Left$(strng$, Looper - 1) + Mid$(strng$, Looper + 1)
  184.         Flag255% = 1
  185.         'Since CHR$(255) was removed we need to back up Looper
  186.         'and Counts because characters all shifted to the left
  187.         Looper = Looper - 1
  188.         Counts = Counts - 1
  189.      
  190.       'If not CHR$(255) then decode watching if Flag255% is set
  191.       Else
  192.         If Flag255% = 1 Then
  193.  
  194.           'Check if error in decoding (Bad password or file)
  195.           CheckIt = ToChange - Adjust(Counts)
  196.           If CheckIt < 0 Or CheckIt > 254 Then
  197.             Errors$ = "INVALID PASSWORD!"
  198.             KTEncrypt$ = original$
  199.             Exit Function
  200.           End If
  201.  
  202.           Mid$(strng$, Looper, 1) = Chr$(ToChange - Adjust(Counts))
  203.           Flag255% = 0
  204.         Else
  205.  
  206.           'Check if error in decoding (Bad password or file)
  207.           CheckIt = ToChange + Adjust(Counts)
  208.           If CheckIt < 0 Or CheckIt > 254 Then
  209.             Errors$ = "INVALID PASSWORD!"
  210.             KTEncrypt$ = original$
  211.             Exit Function
  212.           End If
  213.  
  214.           Mid$(strng$, Looper, 1) = Chr$(ToChange + Adjust(Counts))
  215.         End If
  216.       End If
  217.  
  218.     End If
  219.    
  220.   Loop
  221.  
  222.  
  223.  
  224.  
  225.   'Set function equal to changed string
  226.   If Flag% = 0 Then
  227.    
  228.     'Tack on CHR$(255) to end so it can be recognized as encoded
  229.     KTEncrypt$ = strng$ + String$(5, 255)
  230.  
  231.   Else
  232.    
  233.     KTEncrypt$ = strng$
  234.  
  235.   End If
  236.  
  237. End Function
  238.  
  239.