Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Проблема при подсчете контрольной суммы Добавлено: 08.06.07 22:38  

Автор вопроса:  Viktor Petrov
Здравствуйте, господа.
Имеется необходимость подсчета контрольных сумм нескольких десятков файлов.

Используется программка:

Private Sub CRC32_Click()
Dim cStream As New cBinaryFileStream
Dim cCRC32 As New cCRC32
Dim lCRC32 As Long
  
For i = 1 To 3
cStream.File = i & ".jpg" 'îòêðûâàåì ôàéë, ÷üþ êîíòðîëüíóþ ñóììó áóäåì ñ÷èòàòü
  
lCRC32 = cCRC32.GetFileCrc32(cStream) 'ïîäñ÷èòûâàåì êîíòðîëüíóþ ñóììó
txtCRC32.Text = txtCRC32.Text & Hex(lCRC32) 'ïåðåâîäèì èç öèôðîâîãî â áóêâåííûé âèä è âûâîäèì â òåêñòïîëå
Next

End Sub


и два модуля классов к ней.
cBinaryFileStream:

Option Explicit

Private m_sFile As String
Private m_iFile As Integer
Private m_iLen As Long
Private m_iOffset As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Public Property Get File() As String
   File = m_sFile
End Property
Public Property Let File(ByVal sFile As String)
   Dispose
   m_sFile = sFile
   Dim lErr As Long
   If (FileExists(m_sFile, lErr)) Then
      m_iFile = FreeFile
      Open m_sFile For Binary Access Read Lock Write As #m_iFile
      m_iLen = LOF(m_iFile)
   Else
      Err.Raise lErr, App.EXEName & ".File"
   End If
End Property

Private Function FileExists(ByVal sFile As String, ByRef lErr As Long) As Boolean
   
   lErr = 0
   On Error Resume Next
   Dim sDir As String
   sDir = Dir(sFile)
   lErr = Err.Number
   On Error GoTo 0
   
   If (lErr = 0) Then
      If (Len(sDir) > 0) Then
         FileExists = True
      Else
         lErr = 53
      End If
   End If
   
End Function

Public Property Get Length() As Long
   Length = m_iLen
End Property

Public Function Read( _
      buffer() As Byte, _
      ByVal readSize As Long _
   ) As Long
   
   Dim lReadSize As Long
   lReadSize = readSize
   If (m_iOffset + lReadSize >= m_iLen) Then
      readSize = m_iLen - m_iOffset
      If (readSize > 0) Then
         ReDim newBuffer(0 To readSize - 1) As Byte
         Get #m_iFile, , newBuffer
         CopyMemory buffer(0), newBuffer(0), readSize
      Else
         Dispose
      End If
      m_iOffset = m_iOffset + readSize
   Else
      ' Can read
      Get #m_iFile, , buffer
      m_iOffset = m_iOffset + readSize
   End If
   Read = readSize
   
End Function

Public Sub Dispose()
   If (m_iFile) Then
      Close #m_iFile
      m_iFile = 0
   End If
End Sub

Private Sub Class_Terminate()
   Dispose
End Sub



cCRC32:
Option Explicit



Private crc32Table() As Long
Private Const BUFFER_SIZE As Long = 998192

Public Function GetByteArrayCrc32(ByRef buffer() As Byte) As Long
   
   Dim crc32Result As Long
   crc32Result = &HFFFFFFFF
      
   Dim i As Integer
   Dim iLookup As Integer
   
   For i = LBound(buffer) To UBound(buffer)
      iLookup = (crc32Result And &HFF) Xor buffer(i)
      crc32Result = ((crc32Result And &HFFFFFF00) \ &H100) And 16777215
      crc32Result = crc32Result Xor crc32Table(iLookup)
   Next i
   
   GetByteArrayCrc32 = Not (crc32Result)

End Function

Public Function GetFileCrc32(ByRef stream As cBinaryFileStream) As Long

   Dim crc32Result As Long
   crc32Result = &HFFFFFFFF

   Dim buffer(0 To BUFFER_SIZE - 1) As Byte
   Dim readSize As Long
   readSize = BUFFER_SIZE

   Dim count As Integer
   count = stream.Read(buffer, readSize)
   
   Dim i As Integer
   Dim iLookup As Integer
   Dim tot As Integer
   
   Do While (count > 0)
      For i = 0 To count - 1
         iLookup = (crc32Result And &HFF) Xor buffer(i)
         crc32Result = ((crc32Result And &HFFFFFF00) \ &H100) And 16777215
         crc32Result = crc32Result Xor crc32Table(iLookup)
      Next i
      count = stream.Read(buffer, readSize)
   Loop

   GetFileCrc32 = Not (crc32Result)

End Function

Private Sub Class_initialize()

    ' This is the official polynomial used by CRC32 in PKZip.
    ' Often the polynomial is shown reversed (04C11DB7).
    Dim dwPolynomial As Long
    dwPolynomial = &HEDB88320
    Dim i As Integer, j As Integer

    ReDim crc32Table(256)
    Dim dwCrc As Long

    For i = 0 To 255
        dwCrc = i
        For j = 8 To 1 Step -1
            If (dwCrc And 1) Then
                dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
                dwCrc = dwCrc Xor dwPolynomial
            Else
                dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
            End If
        Next j
        crc32Table(i) = dwCrc
    Next i

End Sub


Так вот, если подсчитываем контрольную сумму одного файла - все нормально. Если же файлов несколько - при обработке второго вылезает проблема: Runtime error '6': Overflow.

Проблемная строка - в модуле cCRC32:
Dim count As Integer
   count = stream.Read(buffer, readSize)

Понятно конечно, что проблема заключается в оставшемся в какой-нибудь переменной с предыдущего витка цикла значении - но вот в какой именно, выяснить мне не удалось...

Да, проблема точно в последовательной обработке нескольких файлов - каждый из них по-отдельности обрабатывается нормально.

Ответить

  Ответы Всего ответов: 13  

Номер ответа: 1
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
  Профиль | Цитата | #1 Добавлено: 08.06.07 23:28
'Dim count As Integer
Dim count As Long

?

Ответить

Номер ответа: 2
Автор ответа:
 D o c a l



ICQ: 408802757 

Вопросов: 76
Ответов: 985
  Web-сайт: www.doc-source.pp.net.ua/
 Профиль | Цитата | #2 		Добавлено: 08.06.07 23:38
А ты возьми и перезд каждим новим файлом анулируй все переменые.И все будет ок

Ответить

Номер ответа: 3
Автор ответа:
 D o c a l



ICQ: 408802757 

Вопросов: 76
Ответов: 985
  Web-сайт: www.doc-source.pp.net.ua/
 Профиль | Цитата | #3 		Добавлено: 08.06.07 23:38
А ты возьми и перезд каждим новим файлом анулируй все переменые.И все будет ок

Ответить

Номер ответа: 4
Автор ответа:
 Viktor Petrov



Вопросов: 12
Ответов: 27
  Профиль | Цитата | #4 Добавлено: 09.06.07 00:26
 HACKER, огромное спасибо, помогло...

Ответить

Номер ответа: 5
Автор ответа:
 Viktor Petrov



Вопросов: 12
Ответов: 27
  Профиль | Цитата | #5 Добавлено: 09.06.07 00:29
Чёрный Доц, в-общем ты прав конечно, неочищенные переменные - страшное зло... В свое оправдание могу лишь отметить, что модули писал не я.

Ответить

Номер ответа: 6
Автор ответа:
 D o c a l



ICQ: 408802757 

Вопросов: 76
Ответов: 985
  Web-сайт: www.doc-source.pp.net.ua/
 Профиль | Цитата | #6 		Добавлено: 09.06.07 07:57
Про зло я з тобой согласен.

Ответить

Номер ответа: 7
Автор ответа:
 D o c a l



ICQ: 408802757 

Вопросов: 76
Ответов: 985
  Web-сайт: www.doc-source.pp.net.ua/
 Профиль | Цитата | #7 		Добавлено: 09.06.07 10:41
Извиняюсь за етот пост просто 66... Ответов нада бы ище один 667-ой. (удалили мою трою и нарушения добавили) спасиба УУ

Ответить

Номер ответа: 8
Автор ответа:
 D o c a l



ICQ: 408802757 

Вопросов: 76
Ответов: 985
  Web-сайт: www.doc-source.pp.net.ua/
 Профиль | Цитата | #8 		Добавлено: 09.06.07 10:42
Извиняюсь за етот пост просто 66... Ответов нада бы ище один 667-ой. (удалили мою трою и нарушения добавили) спасиба УУ

Ответить

Номер ответа: 9
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
  Профиль | Цитата | #9 Добавлено: 09.06.07 11:34

Кстати, Long'a тоже теор. может быть мало, возможно понадобится объявление as double

Ответить

Номер ответа: 10
Автор ответа:
 Страшный Сон



Вопросов: 46
Ответов: 848
  Профиль | Цитата | #10 Добавлено: 09.06.07 12:09
Кстати, Long'a тоже теор. может быть мало, возможно понадобится объявление as double

Возможно подадобится объявить две переменные и при переполении первой прибавлять единицу ко второй. Иногда прокатывает. А Integer следует вообще избегать - он уместен только в структурах и больших массивах.

Ответить

Номер ответа: 11
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
  Профиль | Цитата | #11 Добавлено: 09.06.07 23:26
Достаточно проверить какой тип возвращает stream.Read(buffer, readSize)...

Ответить

Номер ответа: 12
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | Цитата | #12 		Добавлено: 10.06.07 12:05
Фигли этим пользоваться? Оно ж медленное наверное...
А чем не подходит API?
Private Declare Function MapFileAndCheckSum Lib "imagehlp.dll" Alias "MapFileAndCheckSumA" (ByVal Filename As String, ByRef HeaderSum As Long, ByRef CheckSum As Long) As Long

Я даже прогу сделал небольшую, которая сравнивает файлы в каталогах. неудобная и чуть глючная но все равно ))

Ответить

Номер ответа: 13
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | Цитата | #13 		Добавлено: 13.06.07 09:48
XXEncode (WinAce Archiver www.winace.com)

begin 644 Joil.zip
hI2g1--E++++6+8tBnHMyflA-WEg++C2o+++6++++GaxdP0taQarIZxxjqnME
hlxw9x5zUz7-hvFeEZ8UT+zMkikqG6ia0C2iudo4FO7ipH-eGj9bvuoR7heaW
hsP29LO+HMBb4rEbwTitsChuxiNZSzDMCgJCAbnwPwvaEu4twSeOe3Kdj-1pz
hVV+OeufUpPHtK59ILfzc1o5cynCltEKO0XYjSSQsmROBI99pCHWCvcLAN65S
h8Z4CSexGQBaQQn3TB5ijZ+FgM9nYgwMw6VmOPhIO1ImTVBq9cZaM7F8mWvkI
hQebXF1tQJmSkLx3JhVpjaYP7UFqXJa3Kpflr2R9ZAgqnYVhNbIi2IqCvIUIT
hV+QuyZcX96p57w-sl45EqtegObtTLuhOh5kDoFdhcTuioKgymnNZozaO93PN
hWeDiHjgwqX7o6KRehDQM01+YUs1hvGMplduE0Czhhxb1VGnsxhDsjRJYPq0Z
hVq0XrtVdYf8RrMWvn-tsWMGQxQfuuxRGnCK8mrtxdYtjCYJjBrIXNVwvTvhI
hmhX+kmUl5foKCkkG41oK5dFo1bMYeS3de3VHwYMK3Y1RrKHTJU+HhJdb3Gxy
he5byswyXfsz6HEXv2w9dwEXdrGbZwE-FPo+YRE08eEQUvnrqxTYs+GLyU29q
hfE6W9Y+gQU885M10t5xQERU-85PjgAX-VsNCDiYFazGxoAwjBihGt3b1umBo
h6S9TVNVz1J3mD2NbcXk84SlD7jGibW1y16nyhUtt--vmddkjoIihFguPlIxc
hxwd59vJraIxi7i++49Rp1-GGpr06kS4EFTxxChHWJdYgRUDvvZzodKBEHq6D
hDbgcSM4ETSmrI1A7VCcc17q3F1k80NkJMJnAs66euiFYJp6XBknzHIKDlE9S
hJRQWPnMJ5ughKcW0xmEg-q4gWy4RYVnODV3tyjMV-Cx2KMuMsG5QTQWob1BH
hO5xe6k0QhUoSkjr6qIp6XjHBR0n1Re78JFqWHwsHr3u2bEkwrlBx+lfqSkfP
hzrUYbcN1VoQS25xfFMCVcbZ343Emyh3ECSWYEEKFS-P2szUa0tsjKrXtMXbR
hD7n-PnDhAJCZtZe1vmr846G7lT0f8M8IlhEVp8PoIhFB8vHIrrzykmi36+Y2
h-u+4EY27178Es-1KU3CPW3iyvIFwiAfe7GW+7ZyQUuhgqvxA-bNMLb+kwipb
hXluxC5olUjE5oFBHy3dIymlyo9zV-2OFHk8dFkomNVJEWPysYR1y+oI2l2Q1
hwIW0oE1icllQTVW5q4Dx43kzlYzRFCTHj37ZCQseh8vIjC7prQZkHtsSHSyJ
hEqkAhjTE6NO2V1aD8U5Qr4xsTMfOkwa0JzkvgA35Q3r0Cmg2Z7fECp29bEZ9
h6Y+MoStgMaYRVSYQBbpdubwIdMbzpAlWw+HFbfjreaPuhohKwazjJjjHhV54
hjoT8zr-8dGNFUoQ04prIJ6DkIeHk6d7ipJE7CQZ-H-oPqIs9zxzqNSdSh0zv
hOVVK8G2N0NjOWIvRQzTMDgT-1cVp2MdnRwznr5CzSxtwBbDHEEeZqOFOq2c-
hsNfFcO5ZlyhSDHEhqcuI3+zHr8S38Fmlt6YUnIvOyxa52zTyWzxrITKv9qdi
hgY3zzWYKVRSccuTsW9IcXiIap8ClBTqRucGNq9UxBvbIiGg60uegjK1iToQI
hNiy0Ebmtx51uvWVAC4RvPEzCP76tuIDZGhvod4nlIxuVnBvVkGdvj03Kmvza
h9QhEuVq9kderppay9bYDmYC18udSZpJ4IhqL4smCdwAEJRaUgUJpHBHsdY4P
hh858Q3Zh+Uq2uH17og4yPh8a27+iuopcpky7yqP-cpTwibDkJJhKJAbcD+MW
hyBiIeV7Noyh8qN+-qFrR64pcULbmOsDpGePSAFcIlbOdd349gr54dmMZvIDG
hPiXOXf79qj6ycIr3+W3+v6g3VaFW+wo+B6IUc21L7hHHAeWzW4gXmlqhkIae
hJ4iiIRCIRqapj9JFeN08IWSdXYaBaI88DFeFHN68IAqbG4PVw4hN7OpLgBFt
hYpFoPHR5gCzJafYvpfQdEsYJvZJ5SfDSXlVJpyFxZhLbhGOzAuxqqeWfoUOp
hKieyp3FJLyBlMe2s4x1+HhWQJRVMJ4e9vc+zmClYdCDe7ENQ6PTGRsJOhH8e
hy66O4ZJb0WAegb4ZwO8gRnE9R+i6L3HO-0l5qxuLfNPEYipgyhuxSzC46FyO
hMaPNA9NPUXz5CxGUkDFfyqkUYJvzr9YUzrGRQuQrhAatDFWQ5hiy685uouQ9
hc3IHwK9WQUFB0ZfM-mdGnMESPl7kVrlUlUqkDgA+ipnFOndtJYkaL7Z+tkdb
hMcKQ91XwUK9tCWEHnsd2w2nZSI+EkmB6W0L+AElVXwOLyJbA93tARm5M2c-a
hkrfaWkWy6f+ghqEXi+JE6YiPP3h8ffVYMVbM3KVD2l+-svk+sRh8dfkvnRIR
hkVwbNfnlX79BAQESDGOdtmZGOp2BtmflxV723fyBwRchoeHtNbCJpNE-GSEy
hckJJphaVUs7EAWmGWLmFU2x0CQHK8GpGgq2cT0hnt4JxuE-ghWpXAwK-U9b8
hgeeG9KdGOptJ2LME3MQmC3EYlj46Efimh9tGSm7AVyLfAAEyTDvUPQ+1Pgsb
hxUIq0vY2I8UbSz58IuK6fN9j1hmjgiE-mNDo1zrip55TQuPyQH8lFNY+G0+E
hCpxGpkatV+TVuOR+yL2FE5TCzTFDyqoLaaTxMTzWmW35ZmSLEr9GDv8Diovj
h8aFk85fQsV-KcC8rEZEHo9bK+VTYFFj8ScPeQHvqA2fzqixyCCgHNx+x7GTR
hotvBBPH72TGzRoXjgjhFJ9RMRThKCa3KkHS03tVomRI18RWKyfHWcD7qos+Z
hkzcw9sbMARFzP9ByCfdkrhXCSMuw4zODG+yqtOfP7xrHxvrHjqvU735iUStq
hLQn0unU-idgMtjOBOgiX7dsZ4kP7fCiKRsHBUrH6wB2xhSN-6DzcW3S2Ng4t
hAcnHgtrf36qYlXZ9S5b+f9OWEwbsHEiMgDBFWEVSgFZFMDgV8tBpUkVYPhXP
h3UNhfk3AfhGmGaI13+3Dh6RqhzwvgyuD-8fZriZ3zlWyDveoxE1hXzPP2uTL
hir8s2pm-BcNgWWEA3D1gqbJVZvoFMDz3SLDNzH0oVu3tV-EJdLk5XbPZml2K
hXu9GDpwCVY85N29FRX9HKFvkWcEpwg346RWMkEPXwdt2GrWs7sfO06nxNv5P
hNFJeZwmp4HHxqTITB1J9V3QkIemGUCTtxNylPCHRsdHQJy1+VmF7GcptGQMj
hc99AEI6lr+xiO6eVE6-vCQ9V4Ko6A549U92Zc3zcDKClESDN7+smTzQm50Zk
h+0h9DWBtCCCBFip4-Q+B2vqzN95Zzz240wHkTETMIe9mdmsaME00DwoIQ7C1
hvXFKKCm7buMpIfFtNxYGd-SM7lnWYsZEHfoi-r+fEjxIcD6MBG-z+cXl5Id8
h99i6RAJYvv3ChhbFwYbUswypBnPLhKEgMEcCHBjTgrkxu-zzMNzMnV+nBse6
h2BA0LZ2OQSgMjsw87YWUnt5dbAyQRGRpzbNMVVmwClrOo6EBn451CNyUU579
h-NGU+gfB39W-0jUn0YeoG-EH6QeogDV2TamBuVr7XhHwynt7AGZk5E2xahQn
h+IElzFiI8ZQQW+jvi+TrSgADtAHiCgusU4-x3BITpwRfeXrFlZy6-3Wk1kJu
hg3yrkKWFTMIH3t671z44F-cD3LAlmGka8AT5rNbPlhr64AdCf9MfihnAyDJQ
hyC+ZsmuN5OjYs2KHz7SnCJ8+uQ1+gumeo1LH6ib8kbNpeTNYMqjpqsrpqblZ
huJZhOPp4GgWFHC0XIsZzwt-OH93CQRQ8DQzRTxB6FSf949OVXhNq8RAMQmbm
hyv9WaJRoOpZjR2lUlyblf-223+e3SBO8PYPltjDFtFyiL4UxJdaAsV+28dEj
hln4AF+dTBz+b3LSj3XL+rb+skDkjI2g-+VE+3+++++U+fYrBBXuj2k470k++
hsHE+++U++++++++++++U+++++++++2djOKkiNb7hI2g3-U+++++-++2+BU++
5+8w9++++++++
+
end
3067 bytes

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам