This project is now released in its entirety, with all dependencies included. You can download the project here:
http://www.lloydsplace.com/Cryptor10.zip
Or just the exe here:
http://www.lloydsplace.com/Cryptor10.exe
Some years ago I adopted a policy of always sharing source code for projects released on the forums, for a couple of good reasons. One, coders on the forum including me are here to learn and pick up new skills in PureBasic. If people are releasing libraries and programs without source, the collaboration benefits to everyone are lost. Sharers benefit too by getting useful critique from other coders and learning to do things in a more polished or efficient way. Another great benefit, and this is the only reason I can post on this today, is the fact that posted sourcecode serves as a backup for when you need to restore destroyed files after a HD failure or such. I lost all of this project last year and if I couldn't draw the source from the forum I'd just have to start over. But it was here and the images were easy enough to find again on the free clipart sites and so I could update it to work with PB 5.50, which has no Ascii mode. So, in addition to the files linked above, here is the source for the forum (and for the next time I need to restore it):
Code: Select all
;================================================================
;
; Program: Cryptor for Windows 1.0
; Author: Lloyd Gallant (netmaestro)
; Date: August 15, 2010
; September 19, 2016 updated to PB 5.50
; Target Compiler: PureBasic 4.51
; Target OS: Windows XP/2000 and later
; Warranty: None expressed or implied
;
; License: No restrictions on usage except as below.
; You are free to execute, modify and
; share this project as you see fit.
;
; HOWEVER:
; You are are prohibited from releasing
; this program more or less in its
; entirety under any other name than
; that of the author, Lloyd Gallant
; and you may not require a payment
; in any form in exchange for it. All
; rights to this code remain with the
; author.
;
;================================================================
;
UseCRC32Fingerprint()
Import "gdiplus.lib"
GdiplusStartup(a,b,c)
GdiplusShutdown(a)
GdipCreateBitmapFromStream(a,b)
GdipDrawImageRectI(a,b,c,d,e,f)
GdipDisposeImage(a)
GdipCreateFromHDC(a,b)
GdipDeleteGraphics(a)
GdipCreatePen1(a,b.f,c,d)
GdipCreatePen2(a,b.f,c,d)
GdipCreateLineBrush(a,b,c,d,e,f)
GdipSetSmoothingMode(a,b)
GdipDrawArc(a.l,b.l,c.f,d.f,e.f,f.f,g.f,h.f)
GdipSetPenEndCap(a,b)
GdipDeletePen(a)
GdipReleaseDC(a,b)
GdipDrawString(a, b$, c, d, e, f, g)
GdipCreateFontFamilyFromName(a.p-unicode,b,c)
GdipCreateFont(a,b.f, c, d, e)
GdipCreateSolidFill(a,b)
EndImport
Declare SetRectF(a, b.f, c.f, d.f, e.f)
Declare timerpulse1(uID, uMsg, dwUser, dw1, dw2)
Declare timerpulse2(uID, uMsg, dwUser, dw1, dw2)
Structure GdiplusStartupInput
GdiPlusVersion.l
*DebugEventCallback.DEBUG_EVENT
SuppressBackgroundThread.l
SuppressExternalCodecs.l
EndStructure
Structure StreamObject
block.l
*bits
stream.ISTREAM
EndStructure
Structure POINTF
x.f
y.f
EndStructure
Structure KEYSTRUCT
keyid.a
key.a[32]
initv.a[16]
EndStructure
Structure RECTF
left.f
top.f
width.f
height.f
EndStructure
Structure FILESTAMP
identity_string.a[9] ; should be "[Cryptor]"
keyid.a[1] ; single character found in A-Z
filename.a[255] ; original file name (file gets decrypted to this)
vectorstamp.a[8] ; CRC32 checksum of part of vector, used for comparison of keys with identical ID
checksum.a[8] ; CRC32 checksum of original file (used to test success of decryption)
last_chunksize.l ; size of remaining chunk of the stream, usually different than main chunksize
EndStructure
#Loc_Stamp = SizeOf(FILESTAMP)
#Loc_KeyID = #Loc_Stamp - SizeOf(FILESTAMP\identity_string)
#Loc_szFilename = #Loc_KeyID - SizeOf(FILESTAMP\keyid)
#Loc_VectorStamp = #Loc_szFilename - SizeOf(FILESTAMP\filename)
#Loc_Checksum = #Loc_VectorStamp - SizeOf(FILESTAMP\vectorstamp)
#Loc_Last_ChunkSize = #Loc_Checksum - SizeOf(FILESTAMP\checksum)
#SmoothingModeAntiAlias = 4
#LineCapArrowAnchor = 20
#UnitPixel = 2
#KeySend = 182436
ExamineDesktops()
Global scrw = DesktopWidth(0)
Global scrh = DesktopHeight(0)
Global *pen1, *pen2, *pen3, *baseimage, *baseimage_d, *keyname, currentpen
Global tid, currentbase, *font, *stringbrush, r.RECTF, *nkeyimage
Global icon = CatchImage(#PB_Any, ?icon)
Global abort=0, abortall=0, TimerID
Global *keydata.KEYSTRUCT = AllocateMemory(SizeOf(KEYSTRUCT))
Global *tempkey.KEYSTRUCT = AllocateMemory(SizeOf(KEYSTRUCT))
Global *key = *keydata+OffsetOf(KEYSTRUCT\key)
Global *initv = *keydata+OffsetOf(KEYSTRUCT\initv)
Global keyinstalled = 0, quit=0, recurse=0
Global NewList files.s()
Global alphacc1, alphacc2, soundson=InitSound(), ding
If soundson
ding=CatchSound(#PB_Any, ?ding)
EndIf
; Initialize GDIPlus
input.GdiplusStartupInput\GdiPlusVersion = 1
GdiplusStartup(@*token, @input, #Null)
GdipCreateFontFamilyFromName("Arial", #Null, @*fontFamily)
GdipCreateFont(*fontFamily, 14.0, 1, #UnitPixel, @*font)
GdipCreateSolidFill($FF000000, @*stringbrush)
SetRectF(@r.RECTF, 84.0, 90.0, 16.0, 16.0)
; Load disabled safe image
stream.streamobject
Stream\block = GlobalAlloc_(#GHND, ?safedend-?safed)
Stream\bits = GlobalLock_(Stream\block)
CopyMemory(?safed, stream\bits, ?safedend-?safed)
CreateStreamOnHGlobal_(stream\bits, 0, @Stream\stream)
GdipCreateBitmapFromStream(Stream\stream , @*baseimage_d)
Stream\stream\Release()
GlobalUnlock_(Stream\bits)
GlobalFree_(Stream\block)
; Load Safe image
stream.streamobject
Stream\block = GlobalAlloc_(#GHND, ?safeend-?safe)
Stream\bits = GlobalLock_(Stream\block)
CopyMemory(?safe, stream\bits, ?safeend-?safe)
CreateStreamOnHGlobal_(stream\bits, 0, @Stream\stream)
GdipCreateBitmapFromStream(Stream\stream , @*baseimage)
Stream\stream\Release()
GlobalUnlock_(Stream\bits)
GlobalFree_(Stream\block)
; Load About image
stream.streamobject
Stream\block = GlobalAlloc_(#GHND, ?endabout-?about)
Stream\bits = GlobalLock_(Stream\block)
CopyMemory(?about, stream\bits, ?endabout-?about)
CreateStreamOnHGlobal_(stream\bits, 0, @Stream\stream)
GdipCreateBitmapFromStream(Stream\stream , @*aboutimage)
Stream\stream\Release()
GlobalUnlock_(Stream\bits)
GlobalFree_(Stream\block)
; Load nkey image
stream.streamobject
Stream\block = GlobalAlloc_(#GHND, ?endnkey-?nkey)
Stream\bits = GlobalLock_(Stream\block)
CopyMemory(?nkey, stream\bits, ?endnkey-?nkey)
CreateStreamOnHGlobal_(stream\bits, 0, @Stream\stream)
GdipCreateBitmapFromStream(Stream\stream , @*nkeyimage)
Stream\stream\Release()
GlobalUnlock_(Stream\bits)
GlobalFree_(Stream\block)
CreateImage(1, 300,240)
hdc = StartDrawing(ImageOutput(1))
GdipCreateFromHDC(hdc, @*gfx)
GdipDrawImageRectI(*gfx, *aboutimage, 0, 0, 300, 240)
StopDrawing()
GdipDeleteGraphics(*gfx)
GdipDisposeImage(*aboutimage)
; Create Pens
p1.POINTF\x=12
p1.POINTF\y=42
p2.POINTF\x=193
p2.POINTF\y=193
GdipCreateLineBrush(p1,p2,$FFFFFF00,$FFFF0000, 0, @*lBrush1)
GdipCreateLineBrush(p1,p2,$FFFFFF00,$FF00EE00, 0, @*lBrush2)
GdipCreatePen2(*lBrush1, 12, 0, @*pen1)
GdipCreatePen2(*lBrush2, 12, 0, @*pen2)
GdipCreatePen1($80000000, 12, 0, @*pen3)
GdipSetPenEndCap(*pen1, #LineCapArrowAnchor)
GdipSetPenEndCap(*pen2, #LineCapArrowAnchor)
GdipSetPenEndCap(*pen3, #LineCapArrowAnchor)
currentpen=*pen1
Procedure ShowAboutBox()
OpenWindow(3,0,0,300,310,"About Cryptor:",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
StickyWindow(3, 1)
SetWindowColor(3,#White)
ImageGadget(30,0,10,0,0,ImageID(1))
HyperLinkGadget(31,44,260,250,20,"http://www.lloydsplace.com",#Red)
SetGadgetColor(31,#PB_Gadget_BackColor,#White)
SetGadgetColor(31,#PB_Gadget_FrontColor,#Blue)
SetGadgetFont(31,LoadFont(0, "Microsoft San Serif",11))
Repeat:
ev=WaitWindowEvent()
Select ev
Case #PB_Event_Gadget
If EventGadget() = 31
RunProgram("http://www.lloydsplace.com")
EndIf
EndSelect
Until ev = #PB_Event_CloseWindow
timeKillEvent_(TimerID)
CloseWindow(3)
EndProcedure
Procedure SetRectF(*r.RectF, x.f, y.f, w.f, h.f)
*r\left = x
*r\top = y
*r\width = w
*r\height = h
ProcedureReturn *r
EndProcedure
Procedure RenderBar(angle.d)
CreateImage(0, 189,220, 32, #PB_Image_Transparent)
hdc = StartDrawing(ImageOutput(0))
GdipCreateFromHDC(hdc, @*gfx)
GdipDrawImageRectI(*gfx, currentbase, 0, 0, 189, 220)
GdipSetSmoothingMode(*gfx, #SmoothingModeAntiAlias)
If currentbase = *baseimage
GdipDrawString(*gfx, Chr(*keydata\keyid), -1, *font, r, #Null, *stringbrush)
EndIf
If angle>0 And angle<=360
GdipDrawArc(*gfx, *pen3, 13,43,164,164,-90,angle)
GdipDrawArc(*gfx, currentpen, 12,42,163,163,-90,angle)
EndIf
GdipReleaseDC(*gfx, hdc)
GdipDeleteGraphics(*gfx)
sz.SIZE\cx = ImageWidth(0) : sz\cy = ImageHeight(0)
ContextOffset.POINT
BlendMode.BLENDFUNCTION
BlendMode\SourceConstantAlpha = 255
BlendMode\AlphaFormat = 1
UpdateLayeredWindow_(WindowID(0), 0, 0, @sz, hDC, @ContextOffset, 0, @BlendMode, 2)
StopDrawing()
EndProcedure
Procedure WriteLog(str$, highlight=0)
AddGadgetItem(20, -1, FormatDate("%hh:%ii:%ss", Date())+Chr(10)+str$)
item = CountGadgetItems(20)-1
SendMessage_(GadgetID(20), #LVM_ENSUREVISIBLE, item,0)
If highlight=1
SetGadgetItemColor(20,item,#PB_Gadget_FrontColor, #White, 1)
SetGadgetItemColor(20,item,#PB_Gadget_BackColor, #Red, 1)
ElseIf highlight=2
SetGadgetItemColor(20,item,#PB_Gadget_FrontColor, #White, 1)
SetGadgetItemColor(20,item,#PB_Gadget_BackColor, RGB(0,128,0), 1)
ElseIf highlight = 3
SetGadgetItemColor(20,item,#PB_Gadget_BackColor, #Yellow, 1)
EndIf
EndProcedure
Procedure.s Encode(rawfilename$)
crc32.s = FileFingerprint(rawfilename$, #PB_Cipher_CRC32)
currentpen = *pen1
abort = #False
lastprog=0
chunksize = 4096
If Right(rawfilename$, 4)<>".enc"
encfilename$ = rawfilename$+".enc"
EndIf
attrib=GetFileAttributes(rawfilename$)
readonly=0
If attrib&#PB_FileSystem_ReadOnly
If Not SetFileAttributes(rawfilename$, #PB_FileSystem_Normal)
readonly=1
writelog("Cannot wipe or delete "+rawfilename$, 3)
EndIf
EndIf
If readonly
result=ReadFile(0, rawfilename$)
Else
result=OpenFile(0, rawfilename$)
EndIf
If result
If CreateFile(1, encfilename$)
length.q = Lof(0)
numparts = length/chunksize
lastchunksize = length%chunksize
If lastchunksize
numparts+1
lastchunk = numparts
Else
lastchunk = 0
EndIf
*raw = AllocateMemory(chunksize)
*secure = AllocateMemory(chunksize)
StartAESCipher(0, *key, 256, *initv, #PB_Cipher_CBC|#PB_Cipher_Encode)
For i=1 To numparts
If i=lastchunk
FillMemory(*raw, chunksize, 0, #PB_Byte)
ReadData(0, *raw, lastchunksize)
Else
ReadData(0, *raw, chunksize)
EndIf
AddCipherBuffer(0, *raw, *secure, chunksize)
WriteData(1, *secure, chunksize)
prog.d = i/numparts*360
If prog-lastprog >= 1
lastprog=prog
RenderBar(prog)
EndIf
If abort
FinishCipher(0)
CloseFile(0)
CloseFile(1)
FreeMemory(*raw)
FreeMemory(*secure)
DeleteFile(encfilename$)
renderbar(0)
ProcedureReturn rawfilename$ + "- operation aborted"
EndIf
Next
FinishCipher(0)
outf$ = LSet(GetFilePart(rawfilename$), SizeOf(FILESTAMP\filename), Chr(32))
With writestamp.FILESTAMP
PokeS(@\identity_string, "[Cryptor]", SizeOf(FILESTAMP\identity_string), #PB_Ascii)
PokeS(@\keyid, PeekS(@*keydata\keyid, SizeOf(FILESTAMP\keyid), #PB_Ascii), SizeOf(FILESTAMP\keyid), #PB_Ascii)
AESEncoder(@outf$, @\filename, SizeOf(FILESTAMP\filename), *Key, 256, *Initv)
PokeS(@\vectorstamp, Fingerprint(*initv+5, 10, #PB_Cipher_CRC32), SizeOf(FILESTAMP\vectorstamp), #PB_Ascii)
PokeS(@\checksum, crc32, SizeOf(FILESTAMP\checksum), #PB_Ascii)
If lastchunksize
\last_chunksize = lastchunksize
Else
\last_chunksize = chunksize
EndIf
EndWith
WriteData(1, @writestamp, SizeOf(FILESTAMP))
CloseFile(1)
If FileSize(encfilename$)-SizeOf(FILESTAMP) >= length
result$ = "Success Encrypting "+encfilename$
renderbar(0)
writelog("Wiping "+rawfilename$)
wipecc.d=0
Repeat
wipecc+1
FileSeek(0,0)
FillMemory(*raw, chunksize, 0, #PB_Byte)
For i=1 To numparts
If i=lastchunk
WriteData(0, *raw, lastchunksize)
Else
WriteData(0, *raw, chunksize)
EndIf
Next
FlushFileBuffers(0)
renderbar(wipecc/7.0*360)
Until wipecc > 7
CloseFile(0)
DeleteFile(rawfilename$)
RenderBar(0)
FreeMemory(*raw)
FreeMemory(*secure)
Else
CloseFile(0)
FreeMemory(*raw)
FreeMemory(*secure)
result$ = "Encryption not completed- "+rawfilename$+" not wiped or deleted"
EndIf
Else
CloseFile(0)
result$ = "Unable to create output file "+encfilename$
EndIf
Else
result$ = "Unable to open input file "+rawfilename$
EndIf
ProcedureReturn result$
EndProcedure
Procedure.s Decode(encfilename$)
currentpen = *pen2
abort=#False
lastprog=0
chunksize = 4096
If ReadFile(0, encfilename$)
FileSeek(0, Lof(0)-SizeOf(FILESTAMP))
If ReadString(0, #PB_Ascii, 9) <> "[Cryptor]"
CloseFile(0)
result$ = "Not a valid Cryptor file: "+encfilename$
ProcedureReturn result$
EndIf
FileSeek(0, Lof(0) - #Loc_Last_ChunkSize)
lastchunksize = ReadLong(0)
FileSeek(0, Lof(0) -#Loc_Checksum)
crc32.s = ReadString(0, #PB_Ascii, SizeOf(FILESTAMP\checksum))
FileSeek(0, Lof(0) - #Loc_KeyID)
idin.a = ReadAsciiCharacter(0)
If idin <> *keydata\keyid
CloseFile(0)
result$ = "Encrypted file requires key "+Chr(idin)+", key "+Chr(*keydata\keyid)+" is installed"
ProcedureReturn result$
EndIf
FileSeek(0,Lof(0) - #Loc_szFilename)
*buf = AllocateMemory(SizeOf(FILESTAMP\filename))
ReadData(0, *buf, SizeOf(FILESTAMP\filename))
orig$ = Space(SizeOf(FILESTAMP\filename))
AESDecoder(*buf, @orig$, SizeOf(FILESTAMP\filename), *Key, 256, *Initv)
FreeMemory(*buf)
orig$ = GetPathPart(encfilename$)+Trim(orig$)
FileSeek(0, Lof(0) - #Loc_VectorStamp)
keytest.s = ReadString(0, #PB_Ascii, 8 )
If keytest.s <> Fingerprint(*initv+5, 10, #PB_Cipher_CRC32)
CloseFile(0)
result$ = "Encrypted file requires key "+Chr(idin)+", wrong key "+Chr(*keydata\keyid)+" is installed"
ProcedureReturn result$
EndIf
FileSeek(0, 0)
If FileSize(orig$) <> -1
If FileFingerprint(orig$, #PB_Cipher_CRC32) = crc32
result$ = "Success Decrypting "+orig$+" Checksum OK!"
CloseFile(0)
DeleteFile(encfilename$)
ProcedureReturn result$
Else
CloseFile(0)
result$ = "A different file called "+orig$+" exists - Not overwritten"
ProcedureReturn result$
EndIf
EndIf
If CreateFile(1, orig$)
length.q = Lof(0)
numparts = length/chunksize
*raw = AllocateMemory(chunksize)
*secure = AllocateMemory(chunksize)
StartAESCipher(0, *key, 256, *initv, #PB_Cipher_CBC|#PB_Cipher_Decode)
For i=1 To numparts
ReadData(0, *secure, chunksize)
AddCipherBuffer(0, *secure, *raw, chunksize)
If i=numparts
WriteData(1, *raw, lastchunksize)
Else
WriteData(1, *raw, chunksize)
EndIf
prog.d = i/numparts*360
If prog-lastprog >= 1
lastprog=prog
RenderBar(prog)
EndIf
If abort
FinishCipher(0)
CloseFile(0)
CloseFile(1)
FreeMemory(*raw)
FreeMemory(*secure)
DeleteFile(orig$)
renderbar(0)
ProcedureReturn encfilename$ + "- operation aborted"
EndIf
Next
FinishCipher(0)
CloseFile(0)
CloseFile(1)
RenderBar(360)
FreeMemory(*raw)
FreeMemory(*secure)
If FileFingerprint(orig$, #PB_Cipher_CRC32) = crc32
result$ = "Success Decrypting "+orig$+" Checksum OK!"
DeleteFile(encfilename$)
Else
result$ = "Failure Decrypting "+orig$+" Checksum ERROR!"
EndIf
RenderBar(0)
Else
result$ = "Unable to create output file. "+orig$
EndIf
Else
result$ = "Unable to open input file "+encfilename$
EndIf
ProcedureReturn result$
EndProcedure
Procedure InstallKey(void)
timeBeginPeriod_(1)
HideWindow(0,0)
keyy=0
Repeat
CreateImage(0, 189,220, 32, #PB_Image_Transparent)
hdc = StartDrawing(ImageOutput(0))
GdipCreateFromHDC(hdc, @*gfx)
GdipDrawImageRectI(*gfx, currentbase, 0, 0, 189, 220)
If currentbase = *baseimage
GdipDrawString(*gfx, PeekS(@*keydata\keyid, 1, #PB_Ascii), -1, *font, r, #Null, *stringbrush)
EndIf
GdipDrawImageRectI(*gfx, *nkeyimage, 70, keyy, 60, 60)
GdipSetSmoothingMode(*gfx, #SmoothingModeAntiAlias)
GdipReleaseDC(*gfx, hdc)
GdipDeleteGraphics(*gfx)
sz.SIZE\cx = ImageWidth(0) : sz\cy = ImageHeight(0)
ContextOffset.POINT
BlendMode.BLENDFUNCTION
BlendMode\SourceConstantAlpha = 255
BlendMode\AlphaFormat = 1
UpdateLayeredWindow_(WindowID(0), 0, 0, @sz, hDC, @ContextOffset, 0, @BlendMode, 2)
StopDrawing()
Select keyy
Case 5 To 20
Delay(10)
Case 21 To 40
Delay(7)
Case 41 To 55
Delay(4)
Case 56 To 65
Delay(2)
Case 66 To 95
Delay(0)
EndSelect
keyy+1
Until keyy>95
keyinstalled = #True
currentbase = *baseimage
renderbar(0)
If soundson
If IsSound(ding)
PlaySound(ding)
EndIf
EndIf
timeEndPeriod_(1)
HideWindow(2, 0)
writelog("Key "+PeekS(@*keydata\keyid, 1, #PB_Ascii)+" successfully installed", 2)
EndProcedure
Procedure WinProc(hwnd, msg, wparam, lparam)
result = #PB_ProcessPureBasicEvents
Select msg
Case #WM_COPYDATA
If Not IsThread(tid)
*pp.COPYDATASTRUCT = lparam
Select *pp\dwData
Case #KeySend
If Not keyinstalled
CopyMemory(*pp\lpData, *keydata, SizeOf(KEYSTRUCT))
installtid = CreateThread(@InstallKey(),0)
If IsWindow(1) ; Show installed key
WaitThread(installtid)
Delay(200)
text$ = #Empty$
text$ + "ID: "+RSet(Hex(PeekB(*keydata), #PB_Byte), 2, "0")+#CRLF$
text$+ "Key: "
For i = 1 To 32
Text$ + " " + RSet(Hex(PeekB(*keydata+i), #PB_Byte), 2, "0")
Next i
text$+#CRLF$
text$+"Vector: "
For i = 33 To 48
Text$ + " " + RSet(Hex(PeekB(*keydata+i), #PB_Byte), 2, "0")
Next i
SetGadgetText(2, Text$)
thiskeyid$ = Chr(Val("$"+Mid(GetGadgetItemText(2,0),10,2)))
SetGadgetText(1, thiskeyid$)
EndIf
Else
HideWindow(2, 0)
WriteLog("Please remove existing key before installing a new one",3)
EndIf
EndSelect
Else
HideWindow(2, 0)
WriteLog("Too busy to install key, try again later",3)
EndIf
result = #True
EndSelect
ProcedureReturn result
EndProcedure
Procedure WinProc2(hwnd, msg, wparam, lparam)
result = #PB_ProcessPureBasicEvents
Select msg
Case #WM_SIZING
ResizeGadget(20,0,0,1800,WindowHeight(2)-30)
ResizeGadget(21,WindowWidth(2)/2-GadgetWidth(21)-5,WindowHeight(2)-25,#PB_Ignore,#PB_Ignore)
ResizeGadget(22,WindowWidth(2)/2+5,WindowHeight(2)-25,#PB_Ignore,#PB_Ignore)
EndSelect
ProcedureReturn result
EndProcedure
Procedure Process_Fileset(void)
abortall=#False
cc=0
ForEach files()
If ReadFile(0, files())
If Lof(0) > SizeOf(FILESTAMP)
FileSeek(0, Lof(0)-SizeOf(FILESTAMP))
If ReadString(0,#PB_Ascii,9) <> "[Cryptor]" ; <------ Encode
CloseFile(0)
WriteLog("Encrypting "+files()+"...")
result$ = Encode(files())
Else ; <--------------------------------- Decode
CloseFile(0)
WriteLog("Decrypting "+files()+"...")
result$ = Decode(files())
EndIf
Else
If Lof(0)>0
CloseFile(0)
WriteLog("Encrypting "+files()+"...")
result$ = Encode(files())
Else
CloseFile(0)
result$ = files()+" is a zero-length file - cannot encrypt"
EndIf
EndIf
If FindString(result$, "Success", 1)
cc+1
WriteLog(result$, 2)
Else
WriteLog(result$, 1)
EndIf
Else
WriteLog("Unable to read file "+files(), 1)
EndIf
If abortall
WriteLog("All tasks aborted",1)
RenderBar(0)
Break
EndIf
Next
If cc = 1
WriteLog("1 File processed")
Else
WriteLog(Str(cc)+" Files processed")
EndIf
EndProcedure
Procedure ParseFolder(d,f.s)
k=d+1
If ExamineDirectory(k,f,"*.*")
While NextDirectoryEntry(k)
If DirectoryEntryType(k) = #PB_DirectoryEntry_Directory
If DirectoryEntryName(k)<>"." And DirectoryEntryName(k)<>".."
parseFolder(k,f+DirectoryEntryName(k)+"\")
EndIf
Else
AddElement(files())
files() = f+DirectoryEntryName(k)
EndIf
Wend
FinishDirectory(k)
EndIf
EndProcedure
Procedure EditProc(hwnd, msg, wparam, lparam)
oldproc = GetProp_(hwnd, "oldproc")
Select msg
Case #WM_NCDESTROY
RemoveProp_(hwnd, "oldproc")
Case #WM_RBUTTONUP
DisplayPopupMenu(5, WindowID(1))
EndSelect
ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wparam, lparam)
EndProcedure
Procedure Window_0_Events(event, EventType, EventGadget, EventMenu)
Select event
Case #PB_Event_CloseWindow
quit=1
Case #WM_LBUTTONDOWN
SendMessage_(WindowID(0),#WM_NCLBUTTONDOWN,#HTCAPTION,0)
Case #WM_RBUTTONUP
DisplayPopupMenu(0, WindowID(0))
Case #PB_Event_WindowDrop
If keyinstalled
If IsThread(tid)
SetActiveWindow(0)
WriteLog( "Too busy to receive more work just now, try again later",3)
Else
c$ = EventDropFiles()
HideWindow(2,0)
If FileSize(c$) = -2
;-----------------------------------
; Process all files in folder
;-----------------------------------
ClearList(files())
If recurse
ParseFolder(0, c$+"\")
Else
directory$ = c$
If ExamineDirectory(0, directory$, "*.*")
While NextDirectoryEntry(0)
If DirectoryEntryType(0) = #PB_DirectoryEntry_File
AddElement(files())
files()=directory$+"\"+DirectoryEntryName(0)
EndIf
Wend
FinishDirectory(0)
EndIf
EndIf
tid = CreateThread(@Process_Fileset(),0)
ThreadPriority(tid, 10)
Else
;-----------------------------------------
; Process one or more selected files
;-----------------------------------------
numfiles = CountString(c$,Chr(10))+1
ClearList(files())
For i=1 To numfiles
AddElement(files())
files() = Trim(StringField(c$, i, Chr(10)))
Next
tid = CreateThread(@Process_Fileset(),0)
ThreadPriority(tid, 10)
EndIf
EndIf
Else
HideWindow(2,0)
WriteLog("There is no key installed. Please run an executable key.",3)
EndIf
Case #PB_Event_SysTray
DisplayPopupMenu(0, WindowID(0))
Case #PB_Event_Menu
Select EventMenu
Case 1
HideWindow(0,0)
Case 2
HideWindow(0,1)
Case 3
OpenWindow(1, 0,0,990,240,"Create or View Key",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
StickyWindow(1,1)
TextGadget(0, 449,24,47,20,"Key ID:")
ComboBoxGadget(1, GadgetX(0)+48,20,40,20)
For i=65 To 90
AddGadgetItem(1, -1, Chr(i))
Next
SetGadgetState(1,0)
EditorGadget(2, 15,60,960,60)
SetProp_(GadgetID(2), "oldproc", SetWindowLongPtr_(GadgetID(2), #GWL_WNDPROC, @EditProc()))
SetGadgetFont(2, LoadFont(0, "courier new", 9))
ButtonGadget(3, 375,150,240,20,"Generate")
ButtonGadget(4, 375,175,240,20,"Copy")
ButtonGadget(5, 375,200,240,20,"Create Executable Keyfile")
CreatePopupMenu(5)
MenuItem(51, "Paste")
If keyinstalled ; Show installed key
text$ = #Empty$
text$ + "ID: "+RSet(Hex(PeekB(*keydata), #PB_Byte), 2, "0")+#CRLF$
text$+ "Key: "
For i = 1 To 32
Text$ + " " + RSet(Hex(PeekB(*keydata+i), #PB_Byte), 2, "0")
Next i
text$+#CRLF$
text$+"Vector: "
For i = 33 To 48
Text$ + " " + RSet(Hex(PeekB(*keydata+i), #PB_Byte), 2, "0")
Next i
EndIf
SetGadgetText(2, Text$)
thiskeyid$ = Chr(Val("$"+Mid(GetGadgetItemText(2,0),10,2)))
SetGadgetText(1, thiskeyid$)
Case 4
keygone$ = PeekS(@*keydata\keyid, SizeOf(KEYSTRUCT\keyid), #PB_Ascii)
FillMemory(*keydata, SizeOf(KEYSTRUCT), 0, #PB_Byte)
keyinstalled=0
currentbase=*baseimage_d
RenderBar(0)
If IsWindow(1)
SetGadgetText(1, #Empty$)
ClearGadgetItems(2)
EndIf
HideWindow(2,0)
writelog("Key "+keygone$+" has been removed", 2)
If soundson
If IsSound(ding)
PlaySound(ding)
EndIf
EndIf
Case 5
HideWindow(2,0)
Case 6
If FileSize("cryptorhelp.chm") <= 0
If CreateFile(9, GetCurrentDirectory()+"cryptorhelp.chm")
WriteData(9, ?help, ?endhelp-?help)
CloseFile(9)
RunProgram("cryptorhelp.chm")
EndIf
Else
RunProgram("cryptorhelp.chm")
EndIf
Case 7
ShowAboutBox()
Case 8
If GetMenuItemState(0,8)
SetMenuItemState(0,8,0)
recurse=0
Else
SetMenuItemState(0,8,1)
recurse=1
EndIf
Case 9
End
EndSelect
EndSelect
EndProcedure
Procedure Window_1_Events(event, EventType, EventGadget, EventMenu)
Select event
Case #PB_Event_CloseWindow
CloseWindow(1)
Case #PB_Event_Menu
Select EventMenu()
Case 51
ClearGadgetItems(2)
SetGadgetText(2, GetClipboardText())
test$ = GetGadgetText(2)
If Mid(test$, 1, 9) <> "ID: " Or
Mid(test$, 12, 2) <> #CRLF$ Or
Mid(test$, 14, 9) <> "Key: " Or
Mid(test$, 118, 2) <> #CRLF$ Or
Mid(test$, 120, 9) <> "Vector: " Or
CountString(test$, Chr(32)) <> 59 Or
CountString(test$, #CRLF$) <> 2
MessageRequester("Error:", "Bad key data")
ClearGadgetItems(2)
Else
thiskeyid$ = Chr(Val("$"+Mid(GetGadgetItemText(2,0),10,2)))
SetGadgetText(1, thiskeyid$)
; Transfer the text bytes to key bytes for burning to a new key
PokeA(*tempkey, Asc(GetGadgetText(1)))
foundkey$ = Right(GetGadgetItemText(2, 1), 95)
foundvector$ = Right(GetGadgetItemText(2, 2), 95)
*writeloc = *tempkey + OffsetOf(KEYSTRUCT\key)
For i=1 To 32
PokeA(*writeloc, Val("$"+StringField(foundkey$, i, Chr(32))))
*writeloc + SizeOf(Ascii)
Next
*writeloc = *tempkey + OffsetOf(KEYSTRUCT\initv)
For i=1 To 16
PokeA(*writeloc, Val("$"+StringField(foundvector$, i, Chr(32))))
*writeloc + SizeOf(Ascii)
Next
EndIf
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case 1
SetGadgetItemText(2, 0, "ID: "+RSet(Hex(Asc(GetGadgetText(1)),#PB_Ascii), 2, "0"))
PokeA(*tempkey, Asc(GetGadgetText(1)))
Case 3
If OpenCryptRandom()
If GetGadgetText(1)=#Empty$
MessageRequester("Info:","Please select a key identifier from the dropdown before proceeding")
Else
PokeA(*tempkey, Asc(GetGadgetText(1)))
*position = *tempKey+SizeOf(KEYSTRUCT\keyid)
CryptRandomData(*position, SizeOf(KEYSTRUCT\key)+SizeOf(KEYSTRUCT\initv))
text$ + "ID: "+RSet(Hex(PeekB(*tempkey), #PB_Byte), 2, "0")+#CRLF$
text$+ "Key: "
For i = 1 To 32
Text$ + " " + RSet(Hex(PeekB(*tempkey+i), #PB_Byte), 2, "0")
Next i
text$+#CRLF$
text$+"Vector: "
For i = 33 To 48
Text$ + " " + RSet(Hex(PeekB(*tempkey+i), #PB_Byte), 2, "0")
Next i
CloseCryptRandom()
EndIf
Else
Text$ = "Key generation is not available"
EndIf
SetGadgetText(2, Text$)
Case 4
SendMessage_(GadgetID(2), #EM_SETSEL, 0,-1)
SetClipboardText(GetGadgetText(2))
Case 5
savefile$ = "CryptorKey_"+Chr(PeekA(*tempkey))+".exe"
path$ = PathRequester("Choose a location to save "+savefile$,"")
If path$
; Write the skeleton exe out to HD and position write pointer on datasection
If CreateFile(2, path$+savefile$)
WriteData(2, ?skel, ?endskel-?skel)
FlushFileBuffers(2)
FileSeek(2, 0)
cc=0
While Not Eof(2)
cc+1
FileSeek(2,cc)
If Not Eof(2)
a$ =ReadString(2)
If a$ = "[Cryptor Key]"
found=1
FileSeek(2,cc+13)
Break
EndIf
EndIf
Wend
; Burn the generated key to the datasection of the new key file
If found
WriteData(2, *tempkey, SizeOf(KEYSTRUCT))
EndIf
CloseFile(2)
MessageRequester("Success:","New executable key "+ path$+savefile$+" created",#MB_ICONINFORMATION)
Else
MessageRequester("OOPS!","Can't create the file on "+ path$+savefile$,#MB_ICONERROR)
EndIf
EndIf
EndSelect
EndSelect
EndProcedure
Procedure Window_2_Events(event, EventType, EventGadget, EventMenu)
Select event
Case #PB_Event_CloseWindow
HideWindow(2,1)
Case #PB_Event_Gadget
Select EventGadget
Case 21
If IsThread(tid)
abort=1
EndIf
Case 22
If IsThread(tid)
abort=1
abortall=1
EndIf
EndSelect
EndSelect
EndProcedure
ProcedureDLL.l Instance_Running(LockStr$)
*MyMutex = CreateMutex_(#Null, 1, LockStr$)
If *MyMutex <> 0 And GetLastError_() = #ERROR_ALREADY_EXISTS
CloseHandle_(*MyMutex)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
If Instance_Running("[Cryptor]")
win = FindWindow_("WindowClass_0", "Cryptor")
If win
For i=1 To 4
ShowWindow_(win, #SW_SHOW)
Delay(100)
ShowWindow_(win, #SW_HIDE)
Delay(70)
Next
ShowWindow_(win, #SW_SHOW)
EndIf
End
EndIf
OpenWindow(0,scrw-240,scrh-330,189,189,"Cryptor",#PB_Window_BorderLess|#PB_Window_Invisible)
SetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE, GetWindowLongPtr_(WindowID(0),#GWL_EXSTYLE)|#WS_EX_LAYERED|#WS_EX_TOOLWINDOW)
StickyWindow(0,1)
EnableWindowDrop(0,#PB_Drop_Files,#PB_Drag_Copy)
SetWindowCallback(@WinProc(),0)
;-------------------------------------
; open tasklist display window
;-------------------------------------
OpenWindow(2, WindowX(0)-520, WindowY(0)-40,512,240,"Task list",#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_Invisible)
StickyWindow(2,1)
ListIconGadget(20, 0,0,512, WindowHeight(2)-30, "Time", 60)
AddGadgetColumn(20, 1, "Tasks",1800)
ButtonGadget(21, WindowWidth(2)/2-80-5, 215, 80, 20, "Abort File")
ButtonGadget(22, WindowWidth(2)/2+5, 215, 80, 20, "Abort All")
SetWindowCallback(@WinProc2(), 2)
CreatePopupMenu(0)
MenuItem(1, "Show")
MenuItem(2, "Hide")
MenuItem(3, "Create or View Key")
MenuItem(4, "Remove Key")
MenuItem(5, "Show Task List")
OpenSubMenu("Help")
MenuItem(6, "Cryptor Help")
MenuItem(7, "About Cryptor")
CloseSubMenu()
OpenSubMenu("Options")
MenuItem(8, "Recurse Folders")
CloseSubMenu()
MenuBar()
MenuItem(9, "Exit")
AddSysTrayIcon(0, WindowID(0), ImageID(icon))
currentbase = *baseimage_d
RenderBar(0)
HideWindow(0,0)
quit=0
Repeat
EventID = WaitWindowEvent()
Select EventWindow()
Case 0
Window_0_Events(EventID, EventType(), EventGadget(), EventMenu())
Case 1
Window_1_Events(EventID, EventType(), EventGadget(), EventMenu())
Case 2
Window_2_Events(EventID, EventType(), EventGadget(), EventMenu())
EndSelect
Until quit
GdipDisposeImage(*baseimage)
GdipDeletePen (*pen1 )
GdipDeletePen (*pen2 )
GdipDeletePen (*pen3 )
GdiplusShutdown (*token )
End
DataSection
safe:
IncludeBinary "safe2.png"
safeend:
safed:
IncludeBinary "safe2_disabled.png"
safedend:
icon:
IncludeBinary "padlock3.ico"
iconend:
skel:
IncludeBinary "skeletonkey.exe"
endskel:
about:
IncludeBinary "about.png"
endabout:
help:
IncludeBinary "cryptorhelp.chm"
endhelp:
ding:
IncludeBinary "dingling.wav"
enddingling:
nkey:
IncludeBinary "key.png"
endnkey:
EndDataSection