home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / SDS!_-_Sec1986884132006.psc / clsShredder.cls < prev   
Text File  |  2006-04-13  |  16KB  |  403 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsShredder"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. '***************************************************************************************
  17. '*  SDS V1       Secure Document Shredder Class                                        *
  18. '*                                                                                     *
  19. '*  Created:     March 5, 2005                                                         *
  20. '*  Updated:     April 13, 2006                                                        *
  21. '*  Purpose:     Secure Document Destruction                                           *
  22. '*  Functions:   (listed)                                                              *
  23. '*  Revision:    1.0                                                                   *
  24. '*  Compile:     PCode                                                                 *
  25. '*  Referenced:  Member Class SMT                                                      *
  26. '*  Author:      John Underhill (Steppenwolfe)                                         *
  27. '*                                                                                     *
  28. '***************************************************************************************
  29.  
  30. '/~ Properties ~/
  31. '/~ p_SourceFile        - file to be destroyed
  32. '/~ p_Passes            - number of overwrite cycles
  33. '/~ p_Scattered         - scatter write blocks
  34. '/~ p_Attributes        - reset file attributes
  35.  
  36. '/~ Exposed Routines ~/
  37. '/~ File_Shred          - shred the file
  38. '/~ File_Exists         - test for file existence
  39.  
  40.  
  41. '/~ Notes ~/
  42. '/~ Mysterious clicking sounds on the landline? Pizza van parked down the block
  43. '/~ for over a week? Enron ex-pat?? Then this is exactly what you have been looking for!
  44.  
  45. '/~ I have tested this class against all the leading file recovery vendors, and none of
  46. '/~ them could recover a viable file. [If anything at all], they can only recover a file with
  47. '/~ the random data, nothing of the original document remained.
  48. '/~ I considered using cellular data for the random blocks, but M$ crypto api is quite
  49. '/~ fast, and in this type of application, very effective at producing random data.
  50. '/~ Class uses write api to ensure commits. File cache is flushed at every pass, forcing
  51. '/~ a write to the drive. I had to makes some concessions to speed on block size, but
  52. '/~ given the number of passes, and techniques used, I doubt a file, [or even file fragment]
  53. '/~ could be recovered from the drive. Maybe Rimnjants could chime in with some advice on this?
  54. '/~ Anyhow, use it, don't abuse it, (and be careful! -improper use- of some of these api, can cause
  55. '/~ serious harm to your file system!), and of course, there are no guarantees or warranties
  56. '/~ for fitness of code or anything else.
  57.  
  58. '/~ You know the spiel.. for a comment or a job.. steppenwolfe_2000@yahoo.com
  59. '/~ enjoy!
  60.  
  61.  
  62. Private Const ALG_TYPE_ANY           As Long = 0
  63. Private Const ALG_SID_MD5            As Long = 3
  64. Private Const ALG_CLASS_HASH         As Long = 32768
  65. Private Const HP_HASHVAL             As Long = 2
  66. Private Const HP_HASHSIZE            As Long = 4
  67. Private Const CRYPT_VERIFYCONTEXT    As Long = &HF0000000
  68. Private Const PROV_RSA_FULL          As Long = 1
  69. Private Const MS_ENHANCED_PROV       As String = "Microsoft Enhanced Cryptographic Provider v1.0"
  70.  
  71. Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal strFileName As String, _
  72.                                                                         ByVal dwDesiredAccess As Long, _
  73.                                                                         ByVal dwShareMode As Long, _
  74.                                                                         ByVal lpSecurityAttributes As Long, _
  75.                                                                         ByVal dwCreationDisposition As Long, _
  76.                                                                         ByVal dwFlagsAndAttributes As Long, _
  77.                                                                         ByVal hTemplateFile As Long) As Long
  78.  
  79. Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, _
  80.                                                         ByVal lDistanceToMove As Long, _
  81.                                                         lpDistanceToMoveHigh As Long, _
  82.                                                         ByVal dwMoveMethod As Long) As Long
  83.  
  84. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  85.  
  86.  
  87. Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, _
  88.                                                    lpBuffer As Any, _
  89.                                                    ByVal nNumberOfBytesToWrite As Long, _
  90.                                                    lpNumberOfBytesWritten As Long, _
  91.                                                    ByVal lpOverlapped As Any) As Long
  92.  
  93. Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
  94.  
  95. Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, _
  96.                                                                                               ByVal pszContainer As String, _
  97.                                                                                               ByVal pszProvider As String, _
  98.                                                                                               ByVal dwProvType As Long, _
  99.                                                                                               ByVal dwFlags As Long) As Long
  100.  
  101. Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal hProv As Long, _
  102.                                                             ByVal dwLen As Long, _
  103.                                                             ByVal pbBuffer As String) As Long
  104.  
  105. Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, _
  106.                                                                  ByVal dwFlags As Long) As Long
  107.  
  108. Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, _
  109.                                                                                       ByVal dwFileAttributes As Long) As Long
  110.  
  111. Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
  112.  
  113. Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, _
  114.                                                                         ByVal lpNewFileName As String, _
  115.                                                                         ByVal dwFlags As Long) As Long
  116.  
  117. Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lLongPath As String, _
  118.                                                                                     ByVal lShortPath As String, _
  119.                                                                                     ByVal lBuffer As Long) As Long
  120.  
  121. '/* shredder progress max
  122. Public Event eSCompPMax(lMax As Long)
  123. '/* shredder progress event
  124. Public Event eSCompPTick(lCnt As Long)
  125. '/* shredder complete
  126. Public Event eSCompComplete()
  127.  
  128. Private m_sSourceFile       As String
  129. Private m_lPasses           As Long
  130. Private m_bScattered        As Boolean
  131. Private m_bAttributes       As Boolean
  132.  
  133.  
  134. '/* source file path
  135. Public Property Get p_SourceFile() As String
  136.     p_SourceFile = m_sSourceFile
  137. End Property
  138.  
  139. Public Property Let p_SourceFile(ByVal PropVal As String)
  140.     m_sSourceFile = PropVal
  141. End Property
  142.  
  143. '/* number of deletion passes
  144. Public Property Get p_Passes() As Long
  145.     p_Passes = m_lPasses
  146. End Property
  147.  
  148. Public Property Let p_Passes(ByVal PropVal As Long)
  149.     m_lPasses = PropVal
  150. End Property
  151.  
  152. '/* use scattered block meshing
  153. Public Property Get p_Scattered() As Boolean
  154.     p_Scattered = m_bScattered
  155. End Property
  156.  
  157. Public Property Let p_Scattered(ByVal PropVal As Boolean)
  158.     m_bScattered = PropVal
  159. End Property
  160.  
  161. '/* reset file attributes
  162. Public Property Get p_Attributes() As Boolean
  163.     p_Attributes = m_bAttributes
  164. End Property
  165.  
  166. Public Property Let p_Attributes(ByVal PropVal As Boolean)
  167.     m_bAttributes = PropVal
  168. End Property
  169.  
  170.  
  171. Public Sub File_Shred()
  172. '/* core
  173.  
  174. Dim lLen        As Long
  175. Dim lRemain     As Long
  176. Dim lBCount     As Long
  177. Dim lBlock      As Long
  178. Dim sBlock      As String
  179. Dim aBlock0()   As Byte
  180. Dim aBlock1()   As Byte
  181. Dim aBlock2()   As Byte
  182. Dim aBlock3()   As Byte
  183. Dim aBlock4()   As Byte
  184. Dim aBlock5()   As Byte
  185. Dim aBlock6()   As Byte
  186. Dim aBlock7()   As Byte
  187. Dim aBlock8()   As Byte
  188. Dim aTemp()     As Byte
  189. Dim lCount      As Long
  190. Dim lPasses     As Long
  191. Dim lByte       As Long
  192. Dim lFile       As Long
  193. Dim lOffset     As Long
  194. Dim lNum        As Long
  195. Dim lRet        As Long
  196.  
  197. On Error GoTo Handler
  198.  
  199. '/* block allocation table
  200. '/* size random data chunks
  201. '/* to file size perspective
  202. '/* [8] divisible block units
  203. '/* Note: done only for speed
  204. '/* proper method [non vb] would use
  205. '/* a fixed block size - 1024
  206. '/* 128
  207. '/* 1024
  208. '/* 8192
  209. '/* 65536
  210. '/* 524288
  211. '/* 4194304
  212.  
  213.     lLen = FileLen(m_sSourceFile)
  214.     If lLen < 8 Then GoTo Handler
  215.     '/* reset file attributes to normal
  216.     If p_Attributes Then Set_Attributes
  217.     
  218.     '/* choose the block size
  219.     '/* based on file size
  220.     '/* for speed
  221.     Select Case True
  222.     Case lLen > 4194304
  223.         lBlock = 524288
  224.     Case lLen > 524288
  225.         lBlock = 65536
  226.     Case lLen > 65536
  227.         lBlock = 8192
  228.     Case lLen > 8192
  229.         lBlock = 1024
  230.     Case lLen > 1024
  231.         lBlock = 128
  232.     Case lLen < 1024
  233.         lBlock = lLen / 8
  234.     End Select
  235.  
  236.     '/* block remainder allocation
  237.     lBCount = Int(lLen / lBlock)
  238.     lRemain = lLen - (lBCount * lBlock)
  239.  
  240.     '/* block building
  241.     '/* build random data blocks
  242.     '/* get the random sample string
  243.  
  244.     '~*** build random data blocks ***~
  245.  
  246.     '/* block 0
  247.     sBlock = Set_Block(lBlock)
  248.     'Debug.Print "length: " & lLen
  249.     'Debug.Print "blocks: " & (lBlock * 12) + lRemain
  250.     '/* dimension array to block size
  251.     ReDim aBlock0(0 To lBlock - 1) As Byte
  252.     '/* convert to byte array
  253.     For lByte = 1 To lBlock
  254.         aBlock0(lByte - 1) = Asc(Mid$(sBlock, lByte, 1))
  255.     Next lByte
  256.     
  257.     '/* block 1
  258.     sBlock = Set_Block(lBlock)
  259.     ReDim aBlock1(0 To lBlock - 1) As Byte
  260.     For lByte = 1 To lBlock
  261.         aBlock1(lByte - 1) = Asc(Mid$(sBlock, lByte, 1))
  262.     Next lByte
  263.     
  264.     '/* block 2
  265.     sBlock = Set_Block(lBlock)
  266.     ReDim aBlock2(0 To lBlock - 1) As Byte
  267.     For lByte = 1 To lBlock
  268.         aBlock2(lByte - 1) = Asc(Mid$(sBlock, lByte, 1))
  269.     Next lByte
  270.     
  271.     '/* block 3
  272.     sBlock = Set_Block(lBlock)
  273.     ReDim aBlock3(0 To lBlock - 1) As Byte
  274.     For lByte = 1 To lBlock
  275.         aBlock3(lByte - 1) = Asc(Mid$(sBlock, lByte, 1))
  276.     Next lByte
  277.     
  278.     '/* block 4
  279.     sBlock = Set_Block(lBlock)
  280.     ReDim aBlock4(0 To lBlock - 1) As Byte
  281.     For lByte = 1 To lBlock
  282.         aBlock4(lByte - 1) = Asc(Mid$(sBlock, lByte, 1))
  283.     Next lByte
  284.     
  285.     '/* block 5
  286.     sBlock = Set_Block(lBlock)
  287.     ReDim aBlock5(0 To lBlock - 1) As Byte
  288.     For lByte = 1 To lBlock
  289.         aBlock5(lByte - 1) = Asc(Mid$(sBlock, lByte, 1))
  290.     Next lByte
  291.     
  292.     '/* block 6
  293.     sBlock = Set_Block(lBlock)
  294.     ReDim aBlock6(0 To lBlock - 1) As Byte
  295.     For lByte = 1 To lBlock
  296.         aBlock6(lByte - 1) = Asc(Mid$(sBlock, lByte, 1))
  297.     Next lByte
  298.     
  299.     '/* block 7
  300.     sBlock = Set_Block(lBlock)
  301.     ReDim aBlock7(0 To lBlock - 1) As Byte
  302.     For lByte = 1 To lBlock
  303.         aBlock7(lByte - 1) = Asc(Mid$(sBlock, lByte, 1))
  304.     Next lByte
  305.     
  306.     '/* block 8 - remainder
  307.     If Not lRemain = 0 Then
  308.         sBlock = Set_Block(lRemain)
  309.         ReDim aBlock8(0 To lRemain - 1) As Byte
  310.         For lByte = 1 To lRemain
  311.             aBlock8(lByte - 1) = Asc(Mid$(sBlock, lByte, 1))
  312.         Next lByte
  313.     End If
  314.  
  315.     '~*** overwrite cycles ***~
  316.  
  317.     If m_lPasses = 0 Then m_lPasses = 1
  318.     RaiseEvent eSCompPMax(m_lPasses)
  319.     For lPasses = 1 To m_lPasses
  320.         lOffset = 0
  321.         '/* open for file handle
  322.         lFile = CreateFile(m_sSourceFile, &H40000000, &H1, ByVal 0&, &H3, &H80, 0&)
  323.         '/* a standard overwrite cycle
  324.         For lNum = 1 To lBCount
  325.             '/* move file pointer to next offset
  326.             SetFilePointer lFile, lOffset, ByVal 0&, 0&
  327.             '/* dimension temporary byte array
  328.             ReDim aTemp(0 To lBlock - 1) As Byte
  329.             '/* scatter overwrite block assignment
  330.             If m_bScattered Then
  331.                 lCount = Int(Rnd * 8) + 1
  332.             Else
  333.                 lCount = lCount + 1
  334.             End If
  335.             If lCount > 8 Then lCount = 1
  336.             '/* sequential block writes
  337.             Select Case lCount
  338.             Case 1
  339.                 aTemp = aBlock0
  340.             Case 2
  341.                 aTemp = aBlock1
  342.             Case 3
  343.                 aTemp = aBlock2
  344.             Case 4
  345.                 aTemp = aBlock3
  346.             Case 5
  347.                 aTemp = aBlock4
  348.             Case 6
  349.                 aTemp = aBlock5
  350.             Case 7
  351.                 aTemp = aBlock6
  352.             Case 8
  353.                 aTemp = aBlock7
  354.             End Select
  355.             '/* write to file
  356.             WriteFile lFile, aTemp(0), lBlock, lRet, ByVal 0&
  357.             lOffset = lOffset + lBlock
  358.         Next lNum
  359.         
  360.         '/* test for valid remainder
  361.         If Not lRemain = 0 Then
  362.             SetFilePointer lFile, (lOffset), ByVal 0&, 0&
  363.             WriteFile lFile, aBlock8(0), lRemain, lRet, ByVal 0&
  364.         End If
  365.         
  366.         '/* write results and close
  367.         FlushFileBuffers lFile
  368.         CloseHandle lFile
  369.         RaiseEvent eSCompPTick(lPasses)
  370.         DoEvents
  371.     Next lPasses
  372.     '/* delete the file
  373.     lRet = DeleteFile(m_sSourceFile)
  374.     '/* delay on reboot
  375.     If lRet = 0 Then Delayed_Deletion
  376.     
  377.     RaiseEvent eSCompComplete
  378.     
  379. Handler:
  380.  
  381. End Sub
  382.  
  383. Private Function Set_Block(ByVal lBlock As Long) As String
  384. '/* create chunks of random data using
  385. '/* cryptogenrandom api. If trust is an issue
  386. '/* consider using cellular data, ex. [ISAAC]
  387. '/* but this is very fast, and [I believe],
  388. '/* sufficiently random in this context
  389.  
  390. Dim lReturn     As Long
  391. Dim sBlock      As String
  392. Dim lProv       As Long
  393.  
  394.     '/* size the string
  395.     sBlock = Space$nits
  396. '/* Note:Fssu sizDoEvents
  397.     Next eg.yivent eSCo(m in this coote:Fs LongBs1ahSh   
  398.     'i.(m in p  '/* s8dCo(m in as cosos
  399. '/im lPr    'i.(m in p  '/* s8dCo(m in as cosos
  400. '/im lPr    'i.(m in p  '/* s8dCo(m in as cosos
  401. '/iojuildin      /* g~:Fssur ck siz  'i.(m juildin 0a cByteFm i as cososuf8ingource file path
  402. Ri As Lo        ByVal hosesBlock      AsIi o=urce file pe lFile~kr /* g~: iAinrt        iAk siz  'iByVal lBlock=esIi Scild"Ainrt        iAN> tPathName Lib -z   '/0iAinesN> tPatn0
  403. Diaock      AsIi