Date: 02-16-2022
Return to Index
created by gbSnippets
'XOR encryption using a single character password
'Run this function to encrypt, run again to decrypt
'Primary Code:
'Credit: Author unknown (off the web, but I can't find where!)
Function EncryptMyString(text$, Psw$) As String
Local i As Long, a As Long, temp$
For i = 1 To Len(text$)
a = i Mod Len(Psw$)
If a = 0 Then a = Len(Psw$)
Mid$(temp$,i) = (Chr$(Asc(Mid$(Psw$,a,1)) XOR Asc(Mid$(text$,i,1))))
Next i
Function = temp$
End Function
'Compilable Example: (Jose Includes)
'This code encrypts/decrypts a file. The first time you run it, a sample
'file is created and saved - unencrypted. Press the button again and the
'file is saved as encrypted. Each button press reverses the last action.
'It does not detect whether a file has been encrypted. In my apps, when
'I encrypt a file, I add some "recognition" bytes to the front of the
'file - such as "E+$crlf" so I can check to know if I should decrypt
'the file when it is loaded.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg As Dword, qFreq, qStart, qStop As Quad
%IDC_Button = 100
Function PBMain() As Long
Dialog New Pixels, 0, "Test Code",300,300,300,200, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %IDC_Button,"Push", 50,10,100,20
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local i As Long, txt$, psw$
Select Case Cb.Msg
Case %WM_InitDialog
CreateSampleData
Case %WM_Command
If Cb.Ctl = %IDC_Button And Cb.CtlMsg = %BN_Clicked Then
Open EXE.Path$ + "myfile.txt" For Binary As #1
Get$ #1, Lof(1), txt$
psw$ = "please"
'-------------------------------------------------------
QueryPerformanceFrequency qFreq
QueryPerformanceCounter qStart
Encrypt_asc(txt$, Psw$)
QueryPerformanceCounter qStop
Dialog Set Text hDlg, Time$ + " : " + Format$((qStop-qStart)/qFreq,"###.000") & " seconds"
'-------------------------------------------------------
Seek #1,1 : Put$ #1, txt$ : Close #1
End If
End Select
End Function
Sub CreateSampleData 'run this to create a sample file
Local i As Long
Open EXE.Path$ + "myfile.txt" For Output As #1
Print #1, "Beginning of Sample Text"
For i = 1 To 100000
Print #1, "aadsfadfasdseasjlkpoiupoiupoiu" '3M characters
Next i
Print #1, "End of Sample Text"
Close #1
End Sub
Function Encrypt_Mid(text$, Psw$) As String 'Beene
Local i,a As Long, temp$
temp$ = text$
For i = 1 To Len(text$)
a = (i Mod Len(Psw$)) + 1 'Joseph Cote
Mid$(temp$,i) = (Chr$(Asc(Mid$(Psw$,a,1)) Xor Asc(Mid$(text$,i,1))))
Next i
Function = temp$
End Function
Function Encrypt_ASC(text$, Psw$) As String 'Hanlin
Local i,a As Long, temp$
temp$ = text$
For i = 1 To Len(text$)
a = (i Mod Len(Psw$)) + 1 'Joseph Cote
Asc(temp$,i) = Asc(psw$,a) Xor Asc(temp$,i)
Next i
Function = temp$
End Function
Function Encrypt_Overlay(text$, Psw$) As String 'John Gleason
Local i,a As Long, temp$, c$, result$
temp$ = text$
Dim textArr(1 To Len(text$)) As Byte At StrPtr(text$) 'These are the 3 key lines. Now you can access each byte to
Dim tempArr(1 To Len(temp)) As Byte At StrPtr(temp) 'encode by using array subscripts directly. No pointers
Dim pswArr(1 To Len( psw$)) As Byte At StrPtr(psw$) 'are necessary and it's approx. equal in speed to pointers.
For i = 1 To Len(text$)
a = (i Mod Len(Psw$)) + 1 'Joseph Cote
tempArr(i) = textArr(i) Xor pswArr(a)
Next i
Function = temp$
End Function
Function Encrypt_PTRA(txt$, psw$) As Long 'Wayne Diamond
Local i,kEnd,StrPtrrPW As Long, tPtr, kPtr As Byte Ptr
tPtr = StrPtr(txt$)
kPtr = StrPtr(psw$)
kEnd = kPtr + Len(psw$)
StrPtrrPW = kPtr
For i = 1 To Len(txt$)
@tPtr = @tPtr Xor @kPtr
Incr tPtr
If kPtr = kEnd Then kPtr = StrPtrrPW Else Incr kPtr
Next i
End Function
Function Encrypt_PTR_Indx(txt$, psw$) As Long 'Ross Boyd
Local i,j,kEnd As Long, tPtr, kPtr As Byte Ptr
tPtr = StrPtr(txt$)
kPtr = StrPtr(psw$)
kEnd = Len(psw$) - 1
For i = 0 To Len(txt$) - 1
@tPtr[i] Xor = @kPtr[j]
If j = kEnd Then j = 0 Else Incr j
Next i
End Function
Function Encrypt_PEEK(Txt$, psw$) As Long 'Paul Dixon
Register tPtr As Long, kPtr As Long
Local i, kEnd, StrPtrrPW As Long
tPtr = StrPtr(Txt$)
kPtr = StrPtr(psw$)
StrPtrrPW = kPtr
kEnd = kPtr + Len(psw$)
For i = 1 To Len(Txt$)
Poke Byte, tPtr,Peek(Byte,tPtr) Xor Peek(Byte,kPtr)
Incr tPtr
If kPtr = kEnd Then kPtr = StrPtrrPW Else Incr kPtr
Next i
End Function
Function Encrypt_ASM(Txt$, psw$) As Long 'Paul Dixon
Register dummy1 As Long 'make sure the registers aren't used
Register dummy2 As Long
Local i,tPtr,kPtr,kEnd,LenTxt As Long
tPtr = StrPtr(Txt$)
kPtr = StrPtr(psw$)
kEnd = kPtr + Len(psw$)
LenTxt=Len(Txt$)
!mov esi,tPtr 'get pointers to the strings into registers
!mov edi,kPtr
!mov edx,LenTxt
'FOR i = 1 TO LEN(TXT$)
!mov ecx,1 'i = 1
#Align 16
lp:
!mov al,[edi] 'get password character
!xor [esi],al 'xor string character with it
!inc esi 'increment the 2 pointers
!inc edi
!cmp edi,kEnd 'if password pointer is too big then ..
!cmove edi,kPtr '.. reload it
!inc ecx 'NEXT i
!cmp ecx,edx 'i = LENtxt?
!jle short lp 'no, loop back
End Function
'gbs_00234
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm