Windows Cryptor - completed w/source

[netmaestro]

Cryptor10 is an encryption tool utilizing PureBasic's AES library, particularly focusing on streaming the cipher. It is designed to be simple to use and pretty much bulletproof as security goes. AES 256bit encryption using CBC and CryptRandom key/vector is currently not breakable.

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

[flaith]

Tested under Windows XPSP3 : no problemo
Nice program, as usual, thank netmaestro

[Fred]

Works correct here as well !

[netmaestro]

Thanks! (#PB_ProgressBar_Roundhouse )

[Arctic Fox]

It works very well here on Windows Vista, too
It is very easy to use!

Have you thought about an icon in the systray for the application? It might be handy as well
Anyway, excellent work! *thumbs up*

[netmaestro]

Have you thought about an icon in the systray for the application? It might be handy as well

Thanks Arctic! That's going to be the final goal, for sure. Click the systray icon, the safe comes up and you drop something on it. However, it'll probably look for a key file which presumably the user would have on a USB stick. He takes the stick out and the installed application will refuse to decrypt anything. For now though I just wanted to make sure that the progress bar was going to work on different OS's. So far now there's XP, Vista and 7 tested so it's likely going to be OK. Thanks again for testing and feedback

[Little John]

Good idea! And the progress bar is really cool.

The program works fine here on Windows XP SP 3 32 bit.
I noticed that the safe is always on top of all other windows.
Don't know whether this was intended. I personally would prefer
if the safe is not always on top. Anyway, good work ( as always ).

Regards, Little John

[TomS]

I noticed that the safe is always on top of all other windows.
Don't know whether this was intended. I personally would prefer
if the safe is not always on top.

Yeah. That's kinda annoying because it's such a big window. It covers almost the whole "File has been de/encrypted"-Dialog

Things I'd like to see in a future version (if planned):

• Systray Icon (Click on the safe hides it, right click for options menu and exit)
• User definable hotkey to unhide from systray
• Option to set/remove File-Contextmenu entries "Encrypt with WC" for all files and "DeCrypt with WC" for enc-files.
• Option link/unlink *.enc to the WC
• Option to encode filename, eg. TopSecret.doc => gLz6dXK2m.enc

Oh yeah: Tested on Win7 32. Works as expected

[luis]

Hi, works here (win7 32 bit ita)

If you drop *any* file with a .enc extensions it "unencrypt" it, even it not encrypted (obviously).
If you drop a file long 0 bytes it will be encrypted as a file 4 bytes long (maybe it's what you want).
If you drop a read only file it says it can not open it.

[netmaestro]

Thanks for the helpful comments. In later versions the decryption program will have a way to test for a proper .enc file, the encrypted file is always at least 4 bytes longer than the original, though as I add more infos to the end of the file this will grow a bit. I didn't know that about the read-only files, I will see if I can't do something about that. I'm using #PB_Drag_Copy as the action so that's probably it.

@TomS: All excellent suggestions. The window has to be sticky if you're going to drop files on it, otherwise as soon as you leftclick a file in explorer the safe will disappear. But this will be easier to deal with once it's a systray application. You could just drop something on it and put it down.

[luis]

I forgot, maybe you could store away the crc of the original file to be able to check the decrypted file is actually as it should be. The usefulness of that (or not) it's dictated by he algo you are using for encrypting (didn't check) but considering it was not a problem to decrypt a false .enc file (and so the algo per se can work without failing with bogus data) maybe it's a good idea (?)

Have fun

[TomS]

The window has to be sticky if you're going to drop files on it, otherwise as soon as you leftclick a file in explorer the safe will disappear. But this will be easier to deal with once it's a systray application. You could just drop something on it and put it down.

Is this a PB-issue, or is there an api call(s) to prevent this?
Because when I open two explorer windows and one is over the other, I can select a file and drag it onto the upper window, without the underlying window coming to the front.
Ofcourse, this is only the case, when I click on the file and instantly start dragging (no mouse-up).
And it works only with one file. If I select many, the window comes to the front.

Of course with a hotkey it's easy.
But this doesn't help the fact that on small screens (or unlucky window positions), the message box informing the user about the results of the operation, is behind the safe.

[netmaestro]

One thing that should help somewhat is I can make the whole thing smaller. It doesn't need to be as large as it is as I have no gadgets planned for the main window.

[TomS]

Or you could disable the "stay on top", before you show the message box. After it, you can enable it again. Since the program is halted as long as there is a messagebox, the user can't interact with it and could put a window in front of it.

[Marco2007]

Very cool!!

The safe is sticky, but the cool progressbar is not...on purpose? -> Win 7 32bit