Lave et lille crypterings program

ohh jeg det glemte jeg min E-mail er "Delmore@ofir.dk" hvis i vil sende mig filerne.

hejsa jeg har et lille meget simpelt eksempel liggende :)
-det er ikke nødvendigt med filer da du bare selv kan smide det i én. som sagt er krypteringen ikke særlig fantastisk...

Option Explicit

#Const CASE_SENSITIVE_PASSWORD = False
Private Function EncryptText(strText As String, ByVal strPwd As String)
Dim i As Integer, c As Integer
Dim strBuff As String

#If Not CASE_SENSITIVE_PASSWORD Then

'Convert password to upper case
'if not case-sensitive
strPwd = UCase$(strPwd)

#End If

'Encrypt string
If Len(strPwd) Then
  For i = 1 To Len(strText)
  c = Asc(Mid$(strText, i, 1))
  c = c + Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1))
  strBuff = strBuff & Chr$(c And &HFF)
  Next i
Else
  strBuff = strText
End If

EncryptText = strBuff

End Function


Private Function DecryptText(strText As String, ByVal strPwd As String)
Dim i As Integer, c As Integer
Dim strBuff As String

#If Not CASE_SENSITIVE_PASSWORD Then


strPwd = UCase$(strPwd)

#End If


If Len(strPwd) Then
For i = 1 To Len(strText)
c = Asc(Mid$(strText, i, 1))
c = c - Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1))
strBuff = strBuff & Chr$(c And &HFF)
Next i
Else
strBuff = strText
End If
DecryptText = strBuff
End Function
Private Sub cmdEncrypt_Click()
Text1 = EncryptText((Text1), Text2)
End Sub

Private Sub cmdDecrypt_Click()
Text1 = DecryptText((Text1), Text2)
End Sub

Se her:
http://www.eksperten.dk/spm/35214

JUBII endelig! Jeg har lavet et sådant program! Jeg kalder det "Keyfile" vent lige lidt!

Jeg har uploaded det her:

http://www.friserverplads.dk/basicpage/keyfile.zip

Jeg har bygget det sådan at du kan vælge den txt fil som du vil lave en .key fil ud af. Den laver simpelt hen teksten om til >{}ü|¯´<'er altså ulæseligt for andre programmer!

Koden til det er ikke i linket, men den kommer lige om lidt!

Kodeordet er "2121"..

Dette gemmer filen:

--------------------------en prosedure------

Public Sub SaveKeyFile(STRR As String)
Dim filen As String
filen = STRR ' ALTSÅ SELVE TXT FILEN

On Error GoTo Fejl

Dim TT, Navn As String

Navn = filen

Navn = Mid(Navn, 1, Len(Navn) - 4) & ".KEY"


Open Navn For Output As #1

' - - - - -

For n = 0 To mainList.ListCount - 1
    For m = 1 To Len(mainList.List(n))
   
    If Mid(mainList.List(n), m, 1) = "a" Then: TT = TT & "d"
    If Mid(mainList.List(n), m, 1) = "A" Then: TT = TT & "e"
   
    If Mid(mainList.List(n), m, 1) = "b" Then: TT = TT & "f"
    If Mid(mainList.List(n), m, 1) = "B" Then: TT = TT & "g"
   
    If Mid(mainList.List(n), m, 1) = "c" Then: TT = TT & "h"
    If Mid(mainList.List(n), m, 1) = "C" Then: TT = TT & "i" ' ALT + 105

    If Mid(mainList.List(n), m, 1) = "d" Then: TT = TT & "j"
    If Mid(mainList.List(n), m, 1) = "D" Then: TT = TT & "k"
   
    If Mid(mainList.List(n), m, 1) = "e" Then: TT = TT & "l"
    If Mid(mainList.List(n), m, 1) = "E" Then: TT = TT & "m" ' ALT 109
   
    If Mid(mainList.List(n), m, 1) = "f" Then: TT = TT & "n"
    If Mid(mainList.List(n), m, 1) = "F" Then: TT = TT & "o"
   
    If Mid(mainList.List(n), m, 1) = "g" Then: TT = TT & "p"
    If Mid(mainList.List(n), m, 1) = "G" Then: TT = TT & "q"
   
    If Mid(mainList.List(n), m, 1) = "h" Then: TT = TT & "r"
    If Mid(mainList.List(n), m, 1) = "H" Then: TT = TT & "s" ' ALT 115
   
    If Mid(mainList.List(n), m, 1) = "i" Then: TT = TT & "t"
    If Mid(mainList.List(n), m, 1) = "I" Then: TT = TT & "u"
   
    If Mid(mainList.List(n), m, 1) = "j" Then: TT = TT & "v"
    If Mid(mainList.List(n), m, 1) = "J" Then: TT = TT & "w"
   
    If Mid(mainList.List(n), m, 1) = "k" Then: TT = TT & "x" ' ALT 120
    If Mid(mainList.List(n), m, 1) = "K" Then: TT = TT & "y"
   
    If Mid(mainList.List(n), m, 1) = "l" Then: TT = TT & "z"
    If Mid(mainList.List(n), m, 1) = "L" Then: TT = TT & "{" ' 123
   
    If Mid(mainList.List(n), m, 1) = "m" Then: TT = TT & "|"
    If Mid(mainList.List(n), m, 1) = "M" Then: TT = TT & "}"
   
    If Mid(mainList.List(n), m, 1) = "n" Then: TT = TT & "~" ' 126
    If Mid(mainList.List(n), m, 1) = "N" Then: TT = TT & "Ç"
   
    If Mid(mainList.List(n), m, 1) = "o" Then: TT = TT & "ü"
    If Mid(mainList.List(n), m, 1) = "O" Then: TT = TT & "é"
   
    If Mid(mainList.List(n), m, 1) = "p" Then: TT = TT & "â" ' 131
    If Mid(mainList.List(n), m, 1) = "P" Then: TT = TT & "ä"
   
    If Mid(mainList.List(n), m, 1) = "q" Then: TT = TT & "é"
    If Mid(mainList.List(n), m, 1) = "Q" Then: TT = TT & "å" ' 134
   
    If Mid(mainList.List(n), m, 1) = "r" Then: TT = TT & "ç"
    If Mid(mainList.List(n), m, 1) = "R" Then: TT = TT & "ê"
   
    If Mid(mainList.List(n), m, 1) = "s" Then: TT = TT & "ë"
    If Mid(mainList.List(n), m, 1) = "S" Then: TT = TT & "è" ' 138
   
    If Mid(mainList.List(n), m, 1) = "t" Then: TT = TT & "ï"
    If Mid(mainList.List(n), m, 1) = "T" Then: TT = TT & "î"
   
    If Mid(mainList.List(n), m, 1) = "u" Then: TT = TT & "ì"
    If Mid(mainList.List(n), m, 1) = "U" Then: TT = TT & "Ä" ' 142
   
    If Mid(mainList.List(n), m, 1) = "v" Then: TT = TT & "Å"
    If Mid(mainList.List(n), m, 1) = "V" Then: TT = TT & "É"
   
    If Mid(mainList.List(n), m, 1) = "w" Then: TT = TT & "æ"
    If Mid(mainList.List(n), m, 1) = "W" Then: TT = TT & "Æ" ' 146
   
    If Mid(mainList.List(n), m, 1) = "x" Then: TT = TT & "ô"
    If Mid(mainList.List(n), m, 1) = "X" Then: TT = TT & "ö"
   
    If Mid(mainList.List(n), m, 1) = "y" Then: TT = TT & "ò"
    If Mid(mainList.List(n), m, 1) = "Y" Then: TT = TT & "û" ' 150
   
    If Mid(mainList.List(n), m, 1) = "z" Then: TT = TT & "ù"
    If Mid(mainList.List(n), m, 1) = "Z" Then: TT = TT & "ÿ"
   
    If Mid(mainList.List(n), m, 1) = "æ" Then: TT = TT & "Ö"
    If Mid(mainList.List(n), m, 1) = "Æ" Then: TT = TT & "Ü"
   
    If Mid(mainList.List(n), m, 1) = "ø" Then: TT = TT & "ø"
    If Mid(mainList.List(n), m, 1) = "Ø" Then: TT = TT & "£" ' 156
 
    If Mid(mainList.List(n), m, 1) = "å" Then: TT = TT & "Ø"
    If Mid(mainList.List(n), m, 1) = "Å" Then: TT = TT & "×"
   
' Tegn

    If Mid(mainList.List(n), m, 1) = " " Then: TT = TT & "/"
    If Mid(mainList.List(n), m, 1) = "." Then: TT = TT & "á" ' 160
    If Mid(mainList.List(n), m, 1) = "," Then: TT = TT & "í"
    If Mid(mainList.List(n), m, 1) = "!" Then: TT = TT & "ó"
    If Mid(mainList.List(n), m, 1) = "?" Then: TT = TT & "ú"
    If Mid(mainList.List(n), m, 1) = "(" Then: TT = TT & "ñ"
    If Mid(mainList.List(n), m, 1) = ")" Then: TT = TT & "Ñ" ' 165
    If Mid(mainList.List(n), m, 1) = "&" Then: TT = TT & "ª"
    If Mid(mainList.List(n), m, 1) = "%" Then: TT = TT & "º"
   
' Tal

    If Mid(mainList.List(n), m, 1) = "0" Then: TT = TT & "¿" ' 168
    If Mid(mainList.List(n), m, 1) = "1" Then: TT = TT & "®"
    If Mid(mainList.List(n), m, 1) = "2" Then: TT = TT & "¬" ' 170
    If Mid(mainList.List(n), m, 1) = "3" Then: TT = TT & "½"
    If Mid(mainList.List(n), m, 1) = "4" Then: TT = TT & "¼"
    If Mid(mainList.List(n), m, 1) = "5" Then: TT = TT & "¡"
    If Mid(mainList.List(n), m, 1) = "6" Then: TT = TT & "«"
    If Mid(mainList.List(n), m, 1) = "7" Then: TT = TT & "»" ' 175
    If Mid(mainList.List(n), m, 1) = "8" Then: TT = TT & "+" ' 191
    If Mid(mainList.List(n), m, 1) = "9" Then: TT = TT & "¥" ' 180
   
    Next m
TT = TT & vbCrLf
Next n

Print #1, TT

' - - - - -

Close #1
Exit Sub
Fejl:
End Sub

Jeg uploader også lige selve .vbp filerne!

Her:

http://www.friserverplads.dk/basicpage/KeyFile.zip

Held og lykke!

Utroligt alle de svar som folk har lavet allerede, jeg kikker på de små programmer. Jeg takker mange gange. Hvis flere har nogle programmer, så bliv endelig ikke tilbage :)
Jeg ved ikke hvordan jeg skal putte point, men det finder jeg ud af efter jeg har kikke på programmerne.

Glæder mig til at se om du kan bruge det.. :)

Kan du bruge det?

Det kan jeg sikkert :)
men jeg har nogle problemer med at åbne programmet med Visual basic.
Kan det være fordi jeg bruger version 5.0 ?
jeg prøver lige og ser om jeg ikke kan finde nogen som bruger 6.0

jeg har en lille app, godt nok lavet i delphi, som kryptere alt ned i 64 bit( arbejder på at gøre den mere sikker), men den virker da..

mail wil@asio.dk

Ok jeg giver point nu, og de går til kantoraza, tillyke
de andre var oxo gode men han hjalp en del mere

Mange tak!

Lukker du lige dit første oprettede spm. herinde på E! Jeg deltager nemlig, og et gult flag ser ikke pænt ud ;)

?