Centar za edukaciju-BiH



#1 16.10.2011 14:04
roko Van mreze
Clan
Registrovan od:02.02.2009
Postovi:236


Predmet:Dali je neko radio sa HASH kodom
Imama funkciju sa neta za standard SHA1 ali mi vrača drukčiju nego iz nekog usporednog programa ?
↑  ↓

#2 16.10.2011 14:24
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,644


Predmet:Re: Dali je neko radio sa HASH kodom
Eh pojasni malo sta ta funkcija radi.
Jel to mozda kodna strana?
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#3 16.10.2011 15:05
roko Van mreze
Clan
Registrovan od:02.02.2009
Postovi:236


Predmet:Re: Dali je neko radio sa HASH kodom
dakle imam određeni asci string i onda se generira digitalni pečat tj sva se polja međusobno melju da se dobije 40 slova i brojeva za autentičnost stringa

HASH sa 40 SHA1 kroz funkciju
Option Explicit
Dim HASS1
Private Type FourBytes
A As Byte
B As Byte
C As Byte
D As Byte
End Type
Private Type OneLong
L As Long
End Type

Function HexDefaultSHA1(Message() As Byte) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
DefaultSHA1 Message, H1, H2, H3, H4, H5
HexDefaultSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function

Function HexSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
xSHA1 Message, Key1, Key2, Key3, Key4, H1, H2, H3, H4, H5
HexSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function

Sub DefaultSHA1(Message() As Byte, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
xSHA1 Message, &H5A827999, &H6ED9EBA1, &H8F1BBCDC, &HCA62C1D6, H1, H2, H3, H4, H5
End Sub

Sub xSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
'CA62C1D68F1BBCDC6ED9EBA15A827999 + "abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
'"abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"

Dim U As Long, P As Long
Dim FB As FourBytes, OL As OneLong
Dim i As Integer
Dim W(80) As Long
Dim A As Long, B As Long, C As Long, D As Long, E As Long
Dim T As Long

H1 = &H67452301: H2 = &HEFCDAB89: H3 = &H98BADCFE: H4 = &H10325476: H5 = &HC3D2E1F0

U = UBound(Message) + 1: OL.L = U32ShiftLeft3(U): A = U \ &H20000000: LSet FB = OL 'U32ShiftRight29(U)

ReDim Preserve Message(0 To (U + 8 And -64) + 63)
Message(U) = 128

U = UBound(Message)
Message(U - 4) = A
Message(U - 3) = FB.D
Message(U - 2) = FB.C
Message(U - 1) = FB.B
Message(U) = FB.A

While P < U
For i = 0 To 15
FB.D = Message(P)
FB.C = Message(P + 1)
FB.B = Message(P + 2)
FB.A = Message(P + 3)
LSet OL = FB
W(i) = OL.L
P = P + 4
Next i

For i = 16 To 79
W(i) = U32RotateLeft1(W(i - 3) Xor W(i - 8) Xor W(i - 14) Xor W(i - 16))
Next i

A = H1: B = H2: C = H3: D = H4: E = H5

For i = 0 To 19
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key1), ((B And C) Or ((Not B) And D)))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i
For i = 20 To 39
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key2), (B Xor C Xor D))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i
For i = 40 To 59
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key3), ((B And C) Or (B And D) Or (C And D)))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i
For i = 60 To 79
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key4), (B Xor C Xor D))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i

H1 = U32Add(H1, A): H2 = U32Add(H2, B): H3 = U32Add(H3, C): H4 = U32Add(H4, D): H5 = U32Add(H5, E)
Wend
End Sub

Function U32Add(ByVal A As Long, ByVal B As Long) As Long
If (A Xor B) < 0 Then
U32Add = A + B
Else
U32Add = (A Xor &H80000000) + B Xor &H80000000
End If
End Function

Function U32ShiftLeft3(ByVal A As Long) As Long
U32ShiftLeft3 = (A And &HFFFFFFF) * 8
If A And &H10000000 Then U32ShiftLeft3 = U32ShiftLeft3 Or &H80000000
End Function

Function U32ShiftRight29(ByVal A As Long) As Long
U32ShiftRight29 = (A And &HE0000000) \ &H20000000 And 7
End Function

Function U32RotateLeft1(ByVal A As Long) As Long
U32RotateLeft1 = (A And &H3FFFFFFF) * 2
If A And &H40000000 Then U32RotateLeft1 = U32RotateLeft1 Or &H80000000
If A And &H80000000 Then U32RotateLeft1 = U32RotateLeft1 Or 1
End Function
Function U32RotateLeft5(ByVal A As Long) As Long
U32RotateLeft5 = (A And &H3FFFFFF) * 32 Or (A And &HF8000000) \ &H8000000 And 31
If A And &H4000000 Then U32RotateLeft5 = U32RotateLeft5 Or &H80000000
End Function
Function U32RotateLeft30(ByVal A As Long) As Long
U32RotateLeft30 = (A And 1) * &H40000000 Or (A And &HFFFC) \ 4 And &H3FFFFFFF
If A And 2 Then U32RotateLeft30 = U32RotateLeft30 Or &H80000000
End Function

Function DecToHex5(ByVal H1 As Long, ByVal H2 As Long, ByVal H3 As Long, ByVal H4 As Long, ByVal H5 As Long) As String
Dim H As String, L As Long
DecToHex5 = "00000000 00000000 00000000 00000000 00000000"
H = Hex(H1): L = Len(H): Mid(DecToHex5, 9 - L, L) = H
H = Hex(H2): L = Len(H): Mid(DecToHex5, 18 - L, L) = H
H = Hex(H3): L = Len(H): Mid(DecToHex5, 27 - L, L) = H
H = Hex(H4): L = Len(H): Mid(DecToHex5, 36 - L, L) = H
H = Hex(H5): L = Len(H): Mid(DecToHex5, 45 - L, L) = H
MsgBox DecToHex5
End Function
Public Function SHA1(str)
Dim i As Integer
Dim arr() As Byte
ReDim arr(0 To Len(str) - 1) As Byte
For i = 0 To Len(str) - 1
arr(i) = Asc(Mid(str, i + 1, 1))
Next i
SHA1 = Replace(LCase(HexDefaultSHA1(arr)), " ", "")
End Function

HASH kroz DLL
Public Function Hash(ByVal strPlainText As String) As String
Dim obHash As Object
On Error GoTo err_Hash
Set obHash = CreateObject("CAPICOM.HashedData")
obHash.Algorithm = 0 'zs SHA1 -
obHash.Hash strPlainText
Hash = obHash.Value
exit_Hash:
strPlainText = ""
Set obHash = Nothing
Exit Function

Exit Function
err_Hash:
MsgBox Err.Number & ": " & Err.Description, vbInformation, "Hash error"
Hash = ""
Resume exit_Hash

End Function

Lud sam več 6 sati
Ovaj post je ureden 1 puta. Posljednja izmjena 17.10.2011 12:15 od strane zxz. ↑  ↓

#4 17.10.2011 12:16
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,644


Predmet:Re: Dali je neko radio sa HASH kodom
Eh nemogu ja ovdje nista vidjeti jer nedostaje aktivx komponenta.
Citat:
Set obHash = CreateObject("CAPICOM.HashedData")
E sad pitanje je jeli ovo radjeno u vb ili accessu.
Ima procedura Replace koje nema u accessu ali dobro moze se napraviti odnosno prepraviti.
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#5 17.10.2011 13:09
roko Van mreze
Clan
Registrovan od:02.02.2009
Postovi:236


Predmet:Re: Dali je neko radio sa HASH kodom
Re : Accesu 2010 ali ima VB7 pa sve radi bez problema
Re Našo sam na netu mali exe koji radi to i exportira kodu txt files pa sam odusto od koda jer je žurba
ako nekom trba google rehash.exe pa se kroz dos hashira fliles
CAPICOM je mikrosoftova slobodna komponenta ali njihov HASH tj SHA1 protokol je drukčiji od evropskog pa zanemarimo stvar . Inače cijela stvar je dosta interesantna kako generirati jedinstvene brojeve tj HASH-ove za neke datoteke pa možeš postaviti autentičnost datoteka
Sejedno hvala
poz..
↑  ↓

Stranice (1):1


Sva vremena su GMT +01:00. Trenutno vrijeme: 7: 01 pm.