' Based on: http://vb.wikia.com/wiki/SHA-1.bas
Option Explicit
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
End Function
' Convert the string into bytes so we can use the above functions
' From Chris Hulbert: http://splinter.com.au/blog
Public Function SHA1HASH(str)
Dim i As Integer
Dim arr() As Byte
On Error Resume Next
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
SHA1HASH = Replace(LCase(HexDefaultSHA1(arr)), " ", "")
End Function
Sub ketThuc()
Dim hetDong As String
Dim a As String
Dim b As Long
Dim c As Long
c = Sheet7.Range("L8").Value
a = Sheet7.Range("A21").Value
hetDong = Sheet3.Range("I1").Value
If a = "" And c <= 6 Then
Sheet7.Range("A" & getLR(Sheet7.Name, "A") + 1).Value = hetDong
Else
MsgBox "Your Quotation is too 6"
Exit Sub
End If
End Sub
Sub layData()
Dim MaKH As String
Dim NgayBaoGia As Date
Dim TroLyNV As String
Dim Item As String
Dim code As String
Dim QuyCach As String
Dim gia As String
Dim tiente As String
Dim MOQ As String
Dim charge As String
Dim donVi As String
Dim mode As String
Dim note As String
Dim SoBaoGia As String
MaKH = FromNhapLieu.txtMaKH.Value
NgayBaoGia = Sheet6.Range("B12").Value
TroLyNV = Sheet6.Range("F31").Value
Item = FromNhapLieu.cbItem.Value
code = FromNhapLieu.txtCode.Value
QuyCach = FromNhapLieu.txtQuyCach.Value
gia = FromNhapLieu.txtGia.Value
tiente = FromNhapLieu.cbTienTeBaoGia.Value
MOQ = FromNhapLieu.txtMOQ.Value
charge = FromNhapLieu.txtSurcharge.Value
donVi = FromNhapLieu.cbDonVi.Value
mode = FromNhapLieu.cbMode.Value
note = FromNhapLieu.txtnote.Value
SoBaoGia = FromNhapLieu.txtNO.Value
With Sheet1
.Range("A" & getLR(Sheet1.Name, "A") + 1).Value = SoBaoGia
.Range("B" & getLR(Sheet1.Name, "B") + 1).Value = MaKH
.Range("C" & getLR(Sheet1.Name, "C") + 1).Value = NgayBaoGia
.Range("D" & getLR(Sheet1.Name, "D") + 1).Value = TroLyNV
.Range("E" & getLR(Sheet1.Name, "E") + 1).Value = Item
.Range("E" & getLR(Sheet1.Name, "F") + 1).Value = code
.Range("G" & getLR(Sheet1.Name, "G") + 1).Value = QuyCach
.Range("H" & getLR(Sheet1.Name, "H") + 1).Value = gia
.Range("I" & getLR(Sheet1.Name, "I") + 1).Value = tiente
.Range("J" & getLR(Sheet1.Name, "J") + 1).Value = MOQ
.Range("K" & getLR(Sheet1.Name, "K") + 1).Value = charge
.Range("M" & getLR(Sheet1.Name, "M") + 1).Value = donVi
.Range("N" & getLR(Sheet1.Name, "N") + 1).Value = mode
.Range("O" & getLR(Sheet1.Name, "O") + 1).Value = note
End With
End Sub
Sub xoafromBaoGia()
With Sheet6
.Range("B13").Value = ""
.Range("H13").Value = ""
.Range("K13").Value = ""
.Range("c24:c27").Value = ""
.Range("A28").Value = ""
.Range("f31").Value = ""
.Range("J33").Value = ""
End With
Sheet7.Range("A2:K1000") = ""
End Sub
Sub xoaFromNhap()
FromNhapLieu.cbItem.Value = ""
FromNhapLieu.txtCode.Value = ""
FromNhapLieu.txtQuyCach.Value = ""
FromNhapLieu.txtGia.Value = ""
FromNhapLieu.cbTienTeBaoGia.Value = ""
FromNhapLieu.txtMOQ.Value = ""
FromNhapLieu.txtSurcharge.Value = ""
FromNhapLieu.cbDonVi.Value = ""
FromNhapLieu.cbMode.Value = ""
FromNhapLieu.txtnote.Value = ""
End Sub
Sub nhapBaoGia()
Dim Item As String
Dim code As String
Dim QuyCach As String
Dim gia As String
Dim tiente As String
Dim MOQ As String
Dim charge As String
Dim donVi As String
Dim mode As String
Dim note As String
Item = FromNhapLieu.cbItem.Value
code = FromNhapLieu.txtCode.Value
QuyCach = FromNhapLieu.txtQuyCach.Value
gia = FromNhapLieu.txtGia.Value
tiente = FromNhapLieu.cbTienTeBaoGia.Value
MOQ = FromNhapLieu.txtMOQ.Value
charge = FromNhapLieu.txtSurcharge.Value
donVi = FromNhapLieu.cbDonVi.Value
mode = FromNhapLieu.cbMode.Value
note = FromNhapLieu.txtnote.Value
With Sheet7
.Range("A" & getLR(Sheet7.Name, "A") + 1).Value = Item
.Range("B" & getLR(Sheet7.Name, "B") + 1).Value = code
.Range("C" & getLR(Sheet7.Name, "C") + 1).Value = QuyCach
.Range("D" & getLR(Sheet7.Name, "D") + 1).Value = gia
.Range("E" & getLR(Sheet7.Name, "E") + 1).Value = tiente
.Range("F" & getLR(Sheet7.Name, "F") + 1).Value = MOQ
.Range("G" & getLR(Sheet7.Name, "G") + 1).Value = charge
.Range("H" & getLR(Sheet7.Name, "H") + 1).Value = donVi
.Range("J" & getLR(Sheet7.Name, "J") + 1).Value = mode
.Range("K" & getLR(Sheet7.Name, "K") + 1).Value = note
End Sub
Sub LuuThongTin()
Dim NguoiLapBieu As String
Dim NghiepVu As String
Dim TenCty As String
Dim MaKH As String
Dim NguoiNhan As String
Dim diaChiXuatHang As String
Dim Trade As String
Dim place As String
Dim tiente As String
Dim VAT As String
NguoiLapBieu = FromNhapLieu.txtUser.Value
NghiepVu = FromNhapLieu.cbNghiepVu.Value
TenCty = FromNhapLieu.txtTenCty.Value
MaKH = FromNhapLieu.txtMaKH.Value
NguoiNhan = FromNhapLieu.txtNguoiNhan.Value
diaChiXuatHang = FromNhapLieu.cbXuatHang.Value
Trade = FromNhapLieu.txtTrade.Value
place = FromNhapLieu.txtPlace.Value
tiente = FromNhapLieu.cbTienTe.Value
VAT = FromNhapLieu.cbThue.Value
With Sheet6
.Range("F31").Value = NguoiLapBieu
.Range("J33").Value = NghiepVu
.Range("B13").Value = TenCty
.Range("H13").Value = MaKH
.Range("K13").Value = NguoiNhan
.Range("C24").Value = diaChiXuatHang
.Range("c25").Value = Trade
.Range("c26").Value = place
.Range("c27").Value = tiente
.Range("A28").Value = VAT
End With
End Sub
Option Explicit
Private Sub cmdInfo_Click()
Call LuuThongTin
MsgBox "Information is saved"
End Sub
Private Sub cmdNhap_Click()
Call nhapBaoGia
Call layData
MsgBox "Your date is recorded!"
Call xoaFromNhap
End Sub
Private Sub cmdXoa_Click()
Call xoafromBaoGia
MsgBox "Your Quotation From Is Refresh"
End Sub
Private Sub CommandButton1_Click()
Call ketThuc
Unload Me
Sheet6.Activate
End Sub
Private Sub txtNgayThayDoi_AfterUpdate()
txtNgayThayDoi = Format(txtNgayThayDoi, "dd/mm/yyyy")
End Sub
Private Sub txtNgayThayDoi_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
txtNgayThayDoi = Format(txtNgayThayDoi, "dd/mm/yyyy")
End Sub
Private Sub txtSo_AfterUpdate()
Me.txtSo.Value = Sheet7.Range("L8").Value
End Sub
Private Sub txtSo_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Me.txtSo.Value = Sheet7.Range("L8").Value
End Sub
Private Sub txtSo_Change()
End Sub
Private Sub txtUser_Change()
Sheet1.[w1] = Me.txtUser.Value
End Sub
Private Sub UserForm_Initialize()
Me.ScrollBars = fmScrollBarsBoth
Me.ScrollHeight = 1000
Me.ScrollWidth = 350
Me.txtUser.Value = Sheet1.[w1]
End Sub
