TIP: Click on subject to list as thread! ANSI
echo: power_bas
to: SANDER SMEENK
from: EDUARD FRANKES
date: 1996-04-27 09:01:00
subject: Coding Names

Hi Sander,
 > Hello All,
 > I'd like some source to code two names to 1 code.
 > And the result may not look like a name converted to numbers.
I think I got something you could use.
Try this one:
parts of program were irelevant,.. deleted
-[Start Of File]-
c= 10   ' Calculation key (Maximum at 3999 Minimum at -4999)
a=c
VER$="2.00  "
CLS
Print"REGISTATION KEY - GENERATOR V ";VER$;"  (C) 1990,1996 Universe SoftWare 
Intl."
Print"Give the -EXACT- name to register : "
Input A$
color ,0
IF A$="" THEN BEEP : locate 6,1:PRINT :?:?:?"NO NAME ENTERED":?"NOTHING TO 
DO.......":?:?:GOTO ENDING
For i =1 to len(a$)
b$=(mid$(a$,i,1))
c=c+INT(asc(b$)*(asc(b$)/i))
next i
C=C*A/2
C$=MID$(STR$(C*LEN(A$)),2)
WHILE LEN(C$) < 8
C$="0" +C$
WEND
print "REGISTRATION KEY FOR THIS NAME IS : ";:COLOR 11:?C$
-[End Of File]-
This one wil calculate an 8 digit number,
spaces, capitals, etc. in the name ARE included!
Some examples:
'Sander Smeenk' will result: 01852760.
'sander smeenk' will result: 02316080
'Eduard Frankes' will result: 01951250.
'eduard frankes' will result: 02380120.
'This is an test for the numbers' result: 05629755.
When using this program for registering,
you must always provide the name that generated the key,
so it can be re-calculated.
 > I need to crypt a name and decrypt a crypted name.. HELP WANTED!!!
If you realy want to encrypt/decrypt things maybe you should try this one:
-[Start Of File]-
CLS
InFile$="A SIMPLE STRING TO BE ENCODED USING A MINIMAL NUMBER OF BITS"
CALL Huffman(InFile$,OutFile$,NewFile$)
print:print:print
PRINT "In:  ";LEN(InFile$);InFile$
PRINT "Out: ";LEN(OutFile$)
PRINT "New: ";LEN(NewFile$);NewFile$
input,r
END
'*****************************************************************************
'   Huffman Encoding File Compression Technique
'
'   From: R Sedgwick.  Algorithms.  Reading, MA: Addison-Wesley.
'                      1984.  Second Ed.  pp  286 / 93.
'
'   Converted to PowerBasic by M. Rosenberg CI$: [73707,2545]
'
SUB Huffman(InText$,OutText$,NewText$)
    SHARED N%,Heap%(),Count%()
    DIM Count%(1024),Heap%(1024),Dad%(1024),Code%(256),Leng%(256)
' Count the frequency of each character in the message to be encoded (P. 287)
    FOR I%=0 to 255 : Count%(I%)=0 : NEXT I%
    Csr%=0 :  DO : INCR Csr% : X%=ASC(MID$(InText$,Csr%,1)) : INCR Count%(X%)
            LOOP UNTIL Csr%=LEN(InText$)
' Initialize the heap array to point to non-zero frequency counts (P. 290)
    N%=0 : FOR I%=0 to 255 : IF Count%(I%)0 THEN INCR N% : Heap%(N%)=I%
          NEXT I%
' Construct an indirect heap on the frequency values (P. 289)
    FOR K% = N% TO 1 STEP -1 : CALL PqDownHeap(K%) : NEXT K%
' Construct the trie (P. 290)
    DO : T%=Heap%(1) : Heap%(1)=Heap%(N%) : DECR N%
        CALL PqDownHeap(1)
        Count%(255+N%)=Count%(Heap%(1))+Count%(T%)
        Dad%(T%)=255+N% : Dad%(Heap%(1))=-255-N%
        Heap%(1)=255+N% : CALL PqDownHeap(1)
    LOOP UNTIL N%=1
    Dad%(255+N%)=0
' Reconstruct the information from the representation of the coding tree 
(P.291)
'    computed during the sifting process.
    FOR K% = 0 TO 255
        IF Count%(K%)=0 THEN
            Code%(K%)=0 : Leng%(K%)=0
        ELSE
            I%=0 : J&=1 : T%=Dad%(K%) : X%=0
            DO : IF T%<0 THEN X%=X%+J& : T%=0-T%
                T%=Dad%(T%) : J&=J&+J& : INCR I%
            LOOP UNTIL T%=0
            Code%(K%)=X% : Leng%(K%)=I%
        END IF
    NEXT K%
' Use the computed representations of the code to encode the string (P. 292)
    J%=0 : OutText$="" : Hold$=""
    DO : INCR J%
        Char%=ASC(MID$(InText$,J%,1)) : Compr$=BIN$(Code%(Char%))
        DO WHILE LEN(Compr$)< Leng%(Char%) : Compr$="0"+Compr$ : LOOP
        Hold$=Hold$+Compr$
        IF LEN(Hold$)>8 THEN
            OutText$=OutText$+CHR$(Bin2Int(LEFT$(Hold$,8)))
            Hold$=RIGHT$(Hold$,LEN(Hold$)-8)
        END IF
    LOOP UNTIL J%=LEN(InText$)
' Add a byte at the end that contains any left-over bits
    IF LEN(Hold$)>0 THEN
        Hold$=Hold$+STRING$(8-LEN(Hold$),"0")
        OutText$=OutText$+CHR$(Bin2Int(LEFT$(Hold$,8)))
    END IF
'*****************************************************************************
' Unpack compressed string into character representation of binary
    J%=0 : UnCompr$="" : NewText$=""
    DO : INCR J%
        Hold$=MID$(OutText$,J%,1) : Hold$=BIN$(ASC(Hold$))
        DO WHILE LEN(Hold$)<8 : Hold$="0"+Hold$ : LOOP
        UnCompr$=UnCompr$+Hold$
    LOOP UNTIL J%=LEN(OutText$)
' Decode compressed string
    DO : FOR  K%=1 TO 256
            IF K%=256 THEN EXIT LOOP        'All done
            IF  Leng%(K%)>0 THEN
                IF Bin2Int(LEFT$(UnCompr$,Leng%(K%)))=Code%(K%) THEN
                    UnCompr$=RIGHT$(UnCompr$,LEN(UnCompr$)-Leng%(K%))
                    NewText$=NewText$+CHR$(K%) : EXIT FOR
                END IF
            END IF
        NEXT K%
    LOOP UNTIL LEN(UnCompr$) = 0
END SUB 'Huffman
SUB PqDownHeap(K%)
' Build and maintain an indirect heap on the frequency values (P. 139)
'     reversing the inequalities since we want the smallest values first.
    SHARED N%,Heap%(),Count%()
    LOCAL J%,V%,Limit%
    V%=Heap%(K%) : Limit% = N%/2
    DO WHILE K% <= Limit%
       J%=K%+K%
       IF J% Count%(Heap%(J%+1)) THEN INCR J%
       IF Count%(V%)<=Count%(Heap%(J%)) THEN Heap%(K%)=V% : EXIT SUB
       Heap%(K%)=Heap%(J%) : Heap%(J%)=V% : K%=J%
    LOOP
END SUB 'PqDownHeap
'*****************************************************************************
FUNCTION Bin2Int(X$)
    X$=RTRIM$(X$) :X$=LTRIM$(X$) : Ll%=LEN(X$) : Ex%=0 : Tot%=0 : I%=Ll%
    DO WHILE I% > 0
        IF MID$(X$,I%,1)="1" THEN Tot&=Tot&+(2^Ex&)
        INCR Ex& : DECR I% : WEND
    Bin2Int=Tot&
END FUNCTION 'Bin2Int
-[End Of File]-
Maybe now you've got what you need!
-[ed]-
--- UBS Intl. Fmail 1.0g+
 # Origin: Universe United Bbs Bussum.. The Original FreeLink (119:3100/0)
---------------
* Origin: United Bbs Systems Europe MailGate to -> Fido USA (2:2802/337.0)

SOURCE: echomail via exec-pc

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.