VB Md5 Şifreleme Kodu *İstek

BUYUR KARDEŞİM İŞİNE YARARSA Bİ TEŞŞEKÜR YETERLİ

Arkadaşlar aşağıdaki kodları bir arkadaştan almıştım ancak bir satırında hata vardı ve sanırım o hatayı düzelttim. aynı kodu aşağıdaki gibi bir modüle ekler ve formada iki adet text ekleyip Kext1 in change yordamına da Text2.Text = UCase(CalculateMD5(Text1.Text)) bu kodu yazarsanız program sorunsuz çalışıyor. emeği geçenlere teşekkür ediyorum.

Hatalı olan kısım :
Private Function MD5StringArray(strInput As String) As Byte()


düzeltimiş hali
Private Function MD5StringArray(strInput As String)






Option Explicit

Private lngTrack As Long
Private arrLongConversion(4) As Long
Private arrSplit64(63) As Byte

Private Const OFFSET_4 = 4294967296#
Private Const MAXINT_4 = 2147483647

Private Const S11 = 7
Private Const S12 = 12
Private Const S13 = 17
Private Const S14 = 22
Private Const S21 = 5
Private Const S22 = 9
Private Const S23 = 14
Private Const S24 = 20
Private Const S31 = 4
Private Const S32 = 11
Private Const S33 = 16
Private Const S34 = 23
Private Const S41 = 6
Private Const S42 = 10
Private Const S43 = 15
Private Const S44 = 21

Private Function MD5Round(strRound As String, a As Long, b As Long, C As Long, d As Long, X As Long, S As Long, ac As Long) As Long

Select Case strRound

Case Is = "FF"
a = MD5LongAdd4(a, (b And C) Or (Not (b) And d), X, ac)
a = MD5Rotate(a, S)
a = MD5LongAdd(a, b)

Case Is = "GG"
a = MD5LongAdd4(a, (b And d) Or (C And Not (d)), X, ac)
a = MD5Rotate(a, S)
a = MD5LongAdd(a, b)

Case Is = "HH"
a = MD5LongAdd4(a, b Xor C Xor d, X, ac)
a = MD5Rotate(a, S)
a = MD5LongAdd(a, b)

Case Is = "II"
a = MD5LongAdd4(a, C Xor (b Or Not (d)), X, ac)
a = MD5Rotate(a, S)
a = MD5LongAdd(a, b)

End Select

End Function

Private Function MD5Rotate(lngValue As Long, lngBits As Long) As Long

Dim lngSign As Long
Dim lngI As Long

lngBits = (lngBits Mod 32)

If lngBits = 0 Then MD5Rotate = lngValue: Exit Function

For lngI = 1 To lngBits
lngSign = lngValue And &HC0000000
lngValue = (lngValue And &H3FFFFFFF) * 2
lngValue = lngValue Or ((lngSign < 0) And 1) Or (CBool(lngSign And &H40000000) And &H80000000)
Next

MD5Rotate = lngValue

End Function

Private Function TRID() As String

Dim sngNum As Single, lngnum As Long
Dim strResult As String

sngNum = Rnd(2147483648#)
strResult = CStr(sngNum)

strResult = Replace(strResult, "0.", "")
strResult = Replace(strResult, ".", "")
strResult = Replace(strResult, "E-", "")

TRID = strResult

End Function

Private Function MD564Split(lngLength As Long, bytBuffer() As Byte) As String

Dim lngBytesTotal As Long, lngBytesToAdd As Long
Dim intLoop As Integer, intLoop2 As Integer, lngTrace As Long
Dim intInnerLoop As Integer, intLoop3 As Integer

lngBytesTotal = lngTrack Mod 64
lngBytesToAdd = 64 - lngBytesTotal
lngTrack = (lngTrack + lngLength)

If lngLength >= lngBytesToAdd Then
For intLoop = 0 To lngBytesToAdd - 1
arrSplit64(lngBytesTotal + intLoop) = bytBuffer(intLoop)
Next intLoop

MD5Conversion arrSplit64

lngTrace = (lngLength) Mod 64

For intLoop2 = lngBytesToAdd To lngLength - intLoop - lngTrace Step 64
For intInnerLoop = 0 To 63
arrSplit64(intInnerLoop) = bytBuffer(intLoop2 + intInnerLoop)
Next intInnerLoop

MD5Conversion arrSplit64

Next intLoop2

lngBytesTotal = 0
Else

intLoop2 = 0

End If

For intLoop3 = 0 To lngLength - intLoop2 - 1

arrSplit64(lngBytesTotal + intLoop3) = bytBuffer(intLoop2 + intLoop3)

Next intLoop3

End Function

Private Function MD5StringArray(strInput As String)

Dim intLoop As Integer
Dim bytBuffer() As Byte
ReDim bytBuffer(Len(strInput))

For intLoop = 0 To Len(strInput) - 1
bytBuffer(intLoop) = Asc(Mid(strInput, intLoop + 1, 1))
Next intLoop

MD5StringArray = bytBuffer

End Function

Private Sub MD5Conversion(bytBuffer() As Byte)

Dim X(16) As Long, a As Long
Dim b As Long, C As Long
Dim d As Long

a = arrLongConversion(1)
b = arrLongConversion(2)
C = arrLongConversion(3)
d = arrLongConversion(4)

MD5Decode 64, X, bytBuffer

MD5Round "FF", a, b, C, d, X(0), S11, -680876936
MD5Round "FF", d, a, b, C, X(1), S12, -389564586
MD5Round "FF", C, d, a, b, X(2), S13, 606105819
MD5Round "FF", b, C, d, a, X(3), S14, -1044525330
MD5Round "FF", a, b, C, d, X(4), S11, -176418897
MD5Round "FF", d, a, b, C, X(5), S12, 1200080426
MD5Round "FF", C, d, a, b, X(6), S13, -1473231341
MD5Round "FF", b, C, d, a, X(7), S14, -45705983
MD5Round "FF", a, b, C, d, X(8), S11, 1770035416
MD5Round "FF", d, a, b, C, X(9), S12, -1958414417
MD5Round "FF", C, d, a, b, X(10), S13, -42063
MD5Round "FF", b, C, d, a, X(11), S14, -1990404162
MD5Round "FF", a, b, C, d, X(12), S11, 1804603682
MD5Round "FF", d, a, b, C, X(13), S12, -40341101
MD5Round "FF", C, d, a, b, X(14), S13, -1502002290
MD5Round "FF", b, C, d, a, X(15), S14, 1236535329

MD5Round "GG", a, b, C, d, X(1), S21, -165796510
MD5Round "GG", d, a, b, C, X(6), S22, -1069501632
MD5Round "GG", C, d, a, b, X(11), S23, 643717713
MD5Round "GG", b, C, d, a, X(0), S24, -373897302
MD5Round "GG", a, b, C, d, X(5), S21, -701558691
MD5Round "GG", d, a, b, C, X(10), S22, 38016083
MD5Round "GG", C, d, a, b, X(15), S23, -660478335
MD5Round "GG", b, C, d, a, X(4), S24, -405537848
MD5Round "GG", a, b, C, d, X(9), S21, 568446438
MD5Round "GG", d, a, b, C, X(14), S22, -1019803690
MD5Round "GG", C, d, a, b, X(3), S23, -187363961
MD5Round "GG", b, C, d, a, X(8), S24, 1163531501
MD5Round "GG", a, b, C, d, X(13), S21, -1444681467
MD5Round "GG", d, a, b, C, X(2), S22, -51403784
MD5Round "GG", C, d, a, b, X(7), S23, 1735328473
MD5Round "GG", b, C, d, a, X(12), S24, -1926607734

MD5Round "HH", a, b, C, d, X(5), S31, -378558
MD5Round "HH", d, a, b, C, X(8), S32, -2022574463
MD5Round "HH", C, d, a, b, X(11), S33, 1839030562
MD5Round "HH", b, C, d, a, X(14), S34, -35309556
MD5Round "HH", a, b, C, d, X(1), S31, -1530992060
MD5Round "HH", d, a, b, C, X(4), S32, 1272893353
MD5Round "HH", C, d, a, b, X(7), S33, -155497632
MD5Round "HH", b, C, d, a, X(10), S34, -1094730640
MD5Round "HH", a, b, C, d, X(13), S31, 681279174
MD5Round "HH", d, a, b, C, X(0), S32, -358537222
MD5Round "HH", C, d, a, b, X(3), S33, -722521979
MD5Round "HH", b, C, d, a, X(6), S34, 76029189
MD5Round "HH", a, b, C, d, X(9), S31, -640364487
MD5Round "HH", d, a, b, C, X(12), S32, -421815835
MD5Round "HH", C, d, a, b, X(15), S33, 530742520
MD5Round "HH", b, C, d, a, X(2), S34, -995338651

MD5Round "II", a, b, C, d, X(0), S41, -198630844
MD5Round "II", d, a, b, C, X(7), S42, 1126891415
MD5Round "II", C, d, a, b, X(14), S43, -1416354905
MD5Round "II", b, C, d, a, X(5), S44, -57434055
MD5Round "II", a, b, C, d, X(12), S41, 1700485571
MD5Round "II", d, a, b, C, X(3), S42, -1894986606
MD5Round "II", C, d, a, b, X(10), S43, -1051523
MD5Round "II", b, C, d, a, X(1), S44, -2054922799
MD5Round "II", a, b, C, d, X(8), S41, 1873313359
MD5Round "II", d, a, b, C, X(15), S42, -30611744
MD5Round "II", C, d, a, b, X(6), S43, -1560198380
MD5Round "II", b, C, d, a, X(13), S44, 1309151649
MD5Round "II", a, b, C, d, X(4), S41, -145523070
MD5Round "II", d, a, b, C, X(11), S42, -1120210379
MD5Round "II", C, d, a, b, X(2), S43, 718787259
MD5Round "II", b, C, d, a, X(9), S44, -343485551

arrLongConversion(1) = MD5LongAdd(arrLongConversion(1), a)
arrLongConversion(2) = MD5LongAdd(arrLongConversion(2), b)
arrLongConversion(3) = MD5LongAdd(arrLongConversion(3), C)
arrLongConversion(4) = MD5LongAdd(arrLongConversion(4), d)

End Sub

Private Function MD5LongAdd(lngVal1 As Long, lngVal2 As Long) As Long

Dim lngHighWord As Long
Dim lngLowWord As Long
Dim lngOverflow As Long

lngLowWord = (lngVal1 And &HFFFF&) + (lngVal2 And &HFFFF&)
lngOverflow = lngLowWord \ 65536
lngHighWord = (((lngVal1 And &HFFFF0000) \ 65536) + ((lngVal2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&

MD5LongAdd = MD5LongConversion((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))

End Function

Private Function MD5LongAdd4(lngVal1 As Long, lngVal2 As Long, lngVal3 As Long, lngVal4 As Long) As Long

Dim lngHighWord As Long
Dim lngLowWord As Long
Dim lngOverflow As Long

lngLowWord = (lngVal1 And &HFFFF&) + (lngVal2 And &HFFFF&) + (lngVal3 And &HFFFF&) + (lngVal4 And &HFFFF&)
lngOverflow = lngLowWord \ 65536
lngHighWord = (((lngVal1 And &HFFFF0000) \ 65536) + ((lngVal2 And &HFFFF0000) \ 65536) + ((lngVal3 And &HFFFF0000) \ 65536) + ((lngVal4 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
MD5LongAdd4 = MD5LongConversion((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))

End Function

Private Sub MD5Decode(intLength As Integer, lngOutBuffer() As Long, bytInBuffer() As Byte)

Dim intDblIndex As Integer
Dim intByteIndex As Integer
Dim dblSum As Double

intDblIndex = 0

For intByteIndex = 0 To intLength - 1 Step 4

dblSum = bytInBuffer(intByteIndex) + bytInBuffer(intByteIndex + 1) * 256# + bytInBuffer(intByteIndex + 2) * 65536# + bytInBuffer(intByteIndex + 3) * 16777216#
lngOutBuffer(intDblIndex) = MD5LongConversion(dblSum)
intDblIndex = (intDblIndex + 1)

Next intByteIndex

End Sub

Private Function MD5LongConversion(dblValue As Double) As Long

If dblValue < 0 Or dblValue >= OFFSET_4 Then Error 6

If dblValue <= MAXINT_4 Then
MD5LongConversion = dblValue
Else
MD5LongConversion = dblValue - OFFSET_4
End If

End Function

Private Sub MD5Finish()

Dim dblBits As Double
Dim arrPadding(72) As Byte
Dim lngBytesBuffered As Long

arrPadding(0) = &H80

dblBits = lngTrack * 8

lngBytesBuffered = lngTrack Mod 64

If lngBytesBuffered <= 56 Then
MD564Split (56 - lngBytesBuffered), arrPadding
Else
MD564Split (120 - lngTrack), arrPadding
End If


arrPadding(0) = MD5LongConversion(dblBits) And &HFF&
arrPadding(1) = MD5LongConversion(dblBits) \ 256 And &HFF&
arrPadding(2) = MD5LongConversion(dblBits) \ 65536 And &HFF&
arrPadding(3) = MD5LongConversion(dblBits) \ 16777216 And &HFF&
arrPadding(4) = 0
arrPadding(5) = 0
arrPadding(6) = 0
arrPadding(7) = 0

MD564Split 8, arrPadding

End Sub

Private Function MD5StringChange(lngnum As Long) As String

Dim bytA As Byte
Dim bytB As Byte
Dim bytC As Byte
Dim bytD As Byte

bytA = lngnum And &HFF&
If bytA < 16 Then
MD5StringChange = "0" & Hex(bytA)
Else
MD5StringChange = Hex(bytA)
End If

bytB = (lngnum And &HFF00&) \ 256
If bytB < 16 Then
MD5StringChange = MD5StringChange & "0" & Hex(bytB)
Else
MD5StringChange = MD5StringChange & Hex(bytB)
End If

bytC = (lngnum And &HFF0000) \ 65536
If bytC < 16 Then
MD5StringChange = MD5StringChange & "0" & Hex(bytC)
Else
MD5StringChange = MD5StringChange & Hex(bytC)
End If

If lngnum < 0 Then
bytD = ((lngnum And &H7F000000) \ 16777216) Or &H80&
Else
bytD = (lngnum And &HFF000000) \ 16777216
End If

If bytD < 16 Then
MD5StringChange = MD5StringChange & "0" & Hex(bytD)
Else
MD5StringChange = MD5StringChange & Hex(bytD)
End If

End Function

Private Function MD5Value() As String

MD5Value = LCase(MD5StringChange(arrLongConversion(1)) & MD5StringChange(arrLongConversion(2)) & MD5StringChange(arrLongConversion(3)) & MD5StringChange(arrLongConversion(4)))

End Function

Public Function CalculateMD5(strMessage As String) As String

Dim bytBuffer() As Byte

bytBuffer = MD5StringArray(strMessage)

MD5Start
MD564Split Len(strMessage), bytBuffer
MD5Finish

CalculateMD5 = MD5Value

End Function

Private Sub MD5Start()

lngTrack = 0
arrLongConversion(1) = MD5LongConversion(1732584193#)
arrLongConversion(2) = MD5LongConversion(4023233417#)
arrLongConversion(3) = MD5LongConversion(2562383102#)
arrLongConversion(4) = MD5LongConversion(271733878#)

End Sub


Açılışta Form Animasyonu

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "USER32" () As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" _
(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, _
ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "USER32" _
(ByVal hWnd As Long, ByVal hRgn As Long, _
ByVal bRedraw As Boolean) As Long

Private Sub Navigate(frm As Form, ByVal NavTo As String)
hBrowse = ShellExecute(frm.hWnd, "open", NavTo, "", "", 5)
End Sub



Private Sub Form_Load()
Form1.BackColor = 10009872
Show
SetWindowRgn hWnd, _
CreateEllipticRgn(0, 0, 500, 500), _
True

End Sub
Private Sub Timer1_Timer()
Dim x, y
Static i
i = (i + 1) Mod 360
y = ScaleHeight / 2 + ScaleHeight / 2 * Sin(i * 3.1415 / 180)
x = ScaleWidth / 2 + ScaleWidth / 2 * Cos(i * 3.1415 / 180)
Line (ScaleWidth / 2, ScaleHeight / 2)-(x, y), i * 10
Label1.Caption = Label1.Caption + 1
If Label1.Caption > 360 Then
Timer2.Enabled = True
End If
End Sub

Private Sub Timer2_Timer()
Timer1.Enabled = False
Label3.Visible = True
Label3.ForeColor = Label4.Caption
Label4.Caption = Label4.Caption + 250000
If Label4.Caption > 16500000 Then
Timer2.Enabled = False
End
End If
End Sub



Buton Animasyonu

'Kullanılan Nesneler
'CommandButton

Private Sub Form_Load()
command1.Caption="BAŞLA BAKALIM
End Sub

Private Sub Command1_Click
Dim j,k
For k=1 to 800
For j=1 to 50
Command1.Caption=j
Next
Next
End Sub

Benim kodlar baya eskimiş