LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel

Liên hệ QC
hậu bối như mình sau 2 năm mới đọc dc chủ đề này và trong 1 ngày đã giải quyết xong tất cả vấn đề về file excel thành file exe khi dùng lockxls
 
Em muốn nhờ anh xem code trong File này lần cuối! Nếu anh xem được nữa thì không bao giờ em đề cập tới vấn đề này nữa ạ!
Trong code này có dòng Msgbox "Hello KieuManh....."
Để chứng thực File này không phải File của người khác!
http://www.mediafire.com/download/5l46vsmrxysml2u/code_lagi.exe
Sub MergeCellFit(ByVal MergeCells As Range)
Dim Diff As Single
Dim FirstCell As Range, MergeCellArea As Range
Dim Col As Long, ColCount As Long, RowCount As Long
Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double
If MergeCells.Count = 1 Then
Set MergeCellArea = MergeCells.MergeArea
Else
Set MergeCellArea = MergeCells
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With MergeCellArea
ColCount = .Columns.Count
RowCount = .Rows.Count
.WrapText = True
If RowCount = 1 And ColCount = 1 Then
.EntireRow.AutoFit
GoTo ExitSub
End If
Set FirstCell = .Cells(1, 1)
FirstCellWidth = FirstCell.ColumnWidth
Diff = 0.75
For Col = 1 To ColCount
MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
Next
.MergeCells = False
FirstCell.ColumnWidth = MergeCellWidth - Diff
.EntireRow.AutoFit
FirstCellHeight = FirstCell.RowHeight
.MergeCells = True
FirstCell.ColumnWidth = FirstCellWidth
FirstCellHeight = FirstCellHeight / RowCount
.RowHeight = FirstCellHeight
End With
ExitSub:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Hello KieuManh dep zai!"
End Sub
 
LockXls chỉ là ảo thuật về giấu file Excel các bạn nhé. Đừng hy vọng bảo mật với nó!
 
Không biết còn ai quan tâm tới Pic này không, Mình đã dùng XLS và có một vấn đề là khi mở file *exe được tạo ra thì không mở được hoặc chỉ mở được vài lần rồi tự dưng không mở file được nữa và xuất hiện bảng như trong ảnh (Số ít các máy bị (khoảng 10%) còn lại là chạy tốt); ai đó có thể cho mình hướng xử lý không?
35749737_2151322595103156_1795393752471175168_n.png
 
đúng như anh mạnh nói, hack LockXLS trong 1 giây là xong:
 
Em muốn nhờ anh xem code trong File này lần cuối! Nếu anh xem được nữa thì không bao giờ em đề cập tới vấn đề này nữa ạ!
Trong code này có dòng Msgbox "Hello KieuManh....."
Để chứng thực File này không phải File của người khác!
http://www.mediafire.com/download/5l46vsmrxysml2u/code_lagi.exe


Sub MergeCellFit(ByVal MergeCells As Range)
Dim Diff As Single
Dim FirstCell As Range, MergeCellArea As Range
Dim Col As Long, ColCount As Long, RowCount As Long
Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double
If MergeCells.Count = 1 Then
Set MergeCellArea = MergeCells.MergeArea
Else
Set MergeCellArea = MergeCells
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With MergeCellArea
ColCount = .Columns.Count
RowCount = .Rows.Count
.WrapText = True
If RowCount = 1 And ColCount = 1 Then
.EntireRow.AutoFit
GoTo ExitSub
End If
Set FirstCell = .Cells(1, 1)
FirstCellWidth = FirstCell.ColumnWidth
Diff = 0.75
For Col = 1 To ColCount
MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
Next
.MergeCells = False
FirstCell.ColumnWidth = MergeCellWidth - Diff
.EntireRow.AutoFit
FirstCellHeight = FirstCell.RowHeight
.MergeCells = True
FirstCell.ColumnWidth = FirstCellWidth
FirstCellHeight = FirstCellHeight / RowCount
.RowHeight = FirstCellHeight
End With
ExitSub:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Hello KieuManh dep zai!"
End Sub
Bài đã được tự động gộp:

Sub MergeCellFit(ByVal MergeCells As Range)
Dim Diff As Single
Dim FirstCell As Range, MergeCellArea As Range
Dim Col As Long, ColCount As Long, RowCount As Long
Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double
If MergeCells.Count = 1 Then
Set MergeCellArea = MergeCells.MergeArea
Else
Set MergeCellArea = MergeCells
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With MergeCellArea
ColCount = .Columns.Count
RowCount = .Rows.Count
.WrapText = True
If RowCount = 1 And ColCount = 1 Then
.EntireRow.AutoFit
GoTo ExitSub
End If
Set FirstCell = .Cells(1, 1)
FirstCellWidth = FirstCell.ColumnWidth
Diff = 0.75
For Col = 1 To ColCount
MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
Next
.MergeCells = False
FirstCell.ColumnWidth = MergeCellWidth - Diff
.EntireRow.AutoFit
FirstCellHeight = FirstCell.RowHeight
.MergeCells = True
FirstCell.ColumnWidth = FirstCellWidth
FirstCellHeight = FirstCellHeight / RowCount
.RowHeight = FirstCellHeight
End With
ExitSub:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Hello KieuManh dep zai!"
End Sub
 
Sub MergeCellFit(ByVal MergeCells As Range)
Dim Diff As Single
Dim FirstCell As Range, MergeCellArea As Range
Dim Col As Long, ColCount As Long, RowCount As Long
Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double
If MergeCells.Count = 1 Then
Set MergeCellArea = MergeCells.MergeArea
Else
Set MergeCellArea = MergeCells
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With MergeCellArea
ColCount = .Columns.Count
RowCount = .Rows.Count
.WrapText = True
If RowCount = 1 And ColCount = 1 Then
.EntireRow.AutoFit
GoTo ExitSub
End If
Set FirstCell = .Cells(1, 1)
FirstCellWidth = FirstCell.ColumnWidth
Diff = 0.75
For Col = 1 To ColCount
MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
Next
.MergeCells = False
FirstCell.ColumnWidth = MergeCellWidth - Diff
.EntireRow.AutoFit
FirstCellHeight = FirstCell.RowHeight
.MergeCells = True
FirstCell.ColumnWidth = FirstCellWidth
FirstCellHeight = FirstCellHeight / RowCount
.RowHeight = FirstCellHeight
End With
ExitSub:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Hello KieuManh dep zai!"
End Sub
Bài đã được tự động gộp:
kiểm tra file này thử bạn
 

File đính kèm

  • Locked.rar
    1.6 MB · Đọc: 65
[QUOTE = "hackVBA, post: 892282, miembro: 1121919"] revisa este archivo para probarte [/ QUOTE]
con mucho gusto !!!

gusto

Sub TEST_CHINH ()
MsgBox ("¡ENCONTRARME EN CÓDIGO!")
End Sub

Jjejejejejejejejejeje

Opción explícita
'https://www.mrexcel.com/forum/excel-questions/573357-prevent-vba-editor-being-opened.html
El usuario declara la función PtrSafe FindWindow Lib "user32.dll" Alias "FindWindowA" (lpClassName ByVal As String, ByVal lpWindowName As String) Siempre que sea


Declare privado Función PtrSafe GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long)


Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, _
ByVal hmod As Long, ByVal dwThreadId as Long) As Long

Declare privado Función PtrSafe CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As Long, _
LParam como cualquiera) tan largo

Declare privado función PtrSafe UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) como largo
Declare privado Función PtrSafe GetCurrentThreadId Lib "kernel32" () como largo
El usuario declara la función PtrSafe GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount como largo) como largo

Public Declare PtrSafe Function SetParent Lib "user32.dll" (ByVal hWndChild As LongPtr, ByVal hWndNewParent, tan largo)
Declare privado Función PtrSafe GetDesktopWindow Lib "user32.dll" () como largo
Función de PtrSafe Bloqueo de función privada Función de declaración de errores Liberación de ventana de actualización "user32.dll" (ByVal hwndLock As LongPtr) Siempre
Función PwSafe ShowWindow Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) Siempre


Private Const GWL_HINSTANCE As Long = (-6)
Constante privado WH_CBT tan largo = 5
Private Const HCBT_ACTIVATE As Long = 5

LCBTHook privado como largo
Privado lVBEhwnd tan largo


Public Sub Hide_The_VBE_Window ()

Application.SendKeys "% {F11}"

lCBTHook = SetWindowsHookEx (WH_CBT, AddressOf CBTProc, _
GetAppInstance, GetCurrentThreadId)

End Sub


Public Sub Restore_The_VBE_Window ()

LockWindowUpdate GetDesktopWindow
ShowWindow lVBEhwnd, 0
SetParent lVBEhwnd, 0
ShowWindow lVBEhwnd, 3
ShowWindow lVBEhwnd, 0
LockWindowUpdate 0

End Sub



Función privada CBTProc _
(ByVal idHook As Long, ByVal wParam As Long, _
ByVal lParam como largo) como largo

Dim sBuffer como cadena
Dim lRetVal As Long
Dim hParentWnd tan largo

'Bloquea la pantalla.
LockWindowUpdate GetDesktopWindow

Seleccionar caso idHook
Caso es = HCBT_ACTIVATE 'Se ha activado una ventana
'¿Es la ventana VBE?
sBuffer = espacio (256)
lRetVal = GetClassName (wParam, sBuffer, 256)
Si se deja a la izquierda (sBuffer, lRetVal) = "wndclass_desked_gsk" Then
'Es nuestra ventana, así que quita el gancho CBT ahora.
UnhookWindowsHookEx lCBTHook
'Ocultar la ventana VBE.
ShowWindow wParam, 0
'Tienda cEa VBE hwnd để giữ lại nó sau.
lVBEhwnd = wParam
'Recuperar la ventana' Trueno 'del proceso XL.
hParentWnd = FindWindow ("ThunderMain", vbNullString)
Si hParentWnd entonces
Haz de la ventana el hijo del Trueno.
'ventana para permanecer invisible.
SetParent wParam, hParentWnd
Terminar si
Terminar si
Selección final

'Desbloquear la pantalla.
LockWindowUpdate 0

CBTProc = CallNextHookEx _
(lCBTHook, idHook, ByVal wParam, ByVal lParam)

Función final


Función privada GetAppInstance () tan larga

GetAppInstance = GetWindowLong _
(FindWindow ("XLMAIN", Application.Caption), GWL_HINSTANCE)

Función final
Bài đã được tự động gộp:

[QUOTE = "TITINO73, post: 900709, miembro: 1171339"] [QUOTE = "hackVBA, post: 892282, miembro: 1121919"] revisa este archivo para probarte [/ QUOTE]
con mucho gusto !!!

gusto

Sub TEST_CHINH ()
MsgBox ("¡ENCONTRARME EN YESDIGO!")
End Sub

Jjejejejejejejejejejejeje

Opción explícita
' https://www.mrexcel.com/forum/excel-questions/573357-prevent-vba-editor-being-opened.html
El usuario declara la función PtrSafe FindWindow Lib "user32.dll" Alias "FindWindowA" (lpClassName ByVal As String, ByVal lpWindowName As String) Siempre barra mar


Declare privado Función PtrSafe GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long)


Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, _
ByVal hmod As Long, ByVal dwThreadId as Long) As Long

Declare privado Función PtrSafe CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As Long, _
LParam como cualquiera) tan largo

Declare privado función PtrSafe UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) como largo
Declare privado Función PtrSafe GetCurrentThreadId Lib "kernel32" () como largo
El usuario declara la función PtrSafe GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount como largo) como largo

Public Declare PtrSafe Function SetParent Lib "user32.dll" (ByVal hWndChild As LongPtr, ByVal hWndNewParent, tan largo)
Declare privado Función PtrSafe GetDesktopWindow Lib "user32.dll" () como largo
Función de Seguridad Bloqueo de funciones privadas
Función de ShowWindow Lib "user32.dll" de PwSafe (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) Siempre


Private Const GWL_HINSTANCE As Long = (-6)
Constante privado WH_CBT tan largo = 5
Private Const HCBT_ACTIVATE As Long = 5

LCBTHook privado como largo
Privado lVBEhwnd tan largo


Public Sub Hide_The_VBE_Window ()

Application.SendKeys "% {F11}"

lCBTHook = SetWindowsHookEx (WH_CBT, AddressOf CBTProc, _
GetAppInstance, GetCurrentThreadId)

End Sub


Public Sub Restore_The_VBE_Window ()

LockWindowUpdate GetDesktopWindow
ShowWindow lVBEhwnd, 0
SetParent lVBEhwnd, 0
ShowWindow lVBEhwnd, 3
ShowWindow lVBEhwnd, 0
LockWindowUpdate 0

End Sub



Funci privada CBTProc _
(ByVal idHook As Long, ByVal wParam As Long, _
PorVal lParam como largo) como largo

Dim sBuffer como cadena
Dim lRetVal As Long
Dim hParentWnd tan largo

'Bloquea la pantalla.
LockWindowUpdate GetDesktopWindow

Seleccionar caso idHook
Caso es = HCBT_ACTIVATE 'Se ha activado una ventana
'¿Es la ventana VBE?
sBuffer = espacio (256)
lRetVal = GetClassName (wParam, sBuffer, 256)
Si deja a la izquierda (sBuffer, lRetVal) = "wndclass_desked_gsk" Entonces
'Es nuestra ventana, así que quita el gancho CBT ahora.
UnhookWindowsHookEx lCBTHook
'Ocultar la ventana VBE.
ShowWindow wParam, 0
'Tienda cEa VBE hwnd para retenerla más tarde.
lVBEhwnd = wParam
'Recuperar la ventana' Trueno 'del proceso XL.
hParentWnd = FindWindow ("ThunderMain", vbNullString)
Si hParentWnd entonces
Haz de la ventana el hijo del Trueno.
'ventana para permanecer invisible.
SetParent wParam, hParentWnd
Terminar si
Terminar si
Selección final

'Desbloquear la pantalla.
LockWindowUpdate 0

CBTProc = CallNextHookEx _
(lCBTHook, idHook, ByVal wParam, ByVal lParam)

Función final


Función privada GetAppInstance () tan larga

GetAppInstance = GetWindowLong _
(FindWindow ("XLMAIN", Application.Caption), GWL_HINSTANCE)

Final Funcion [/ QUOTE]



NO HABIA TENIDO OPORTUNIDAD DE VER EL MENSAJE
 
Lần chỉnh sửa cuối:
Ai có phần mềm clockXLS nào có rack cho mình xin với. Cảm ơn nhiều
 
Không biết còn ai quan tâm tới Pic này không, Mình đã dùng XLS và có một vấn đề là khi mở file *exe được tạo ra thì không mở được hoặc chỉ mở được vài lần rồi tự dưng không mở file được nữa và xuất hiện bảng như trong ảnh (Số ít các máy bị (khoảng 10%) còn lại là chạy tốt); ai đó có thể cho mình hướng xử lý không?
View attachment 197676
Mình cũng bị lỗi này, không biết có cao nhân nào giúp đỡ chỉ cách fix với!
 
Một số máy bị lỗi khi mở file đã chuyển sang exe Lockxls. Giờ thì tôi chán dùng nó rồi.
Chủ pm hình như cũng chán nốt, hơn 1 năm chả update gì dù Office 2021 đã có.
 
Toàn cao thủ !
Mình cũng bị lỗi này, không biết có cao nhân nào giúp đỡ chỉ cách fix với
Mình đang dùng bản mới nhất thấy rất ổn định mà.
Một số máy bị lỗi khi mở file đã chuyển sang exe Lockxls. Giờ thì tôi chán dùng nó rồi.
Chủ pm hình như cũng chán nốt, hơn 1 năm chả update gì dù Office 2021 đã có.
 
Một số máy bị lỗi khi mở file đã chuyển sang exe Lockxls. Giờ thì tôi chán dùng nó rồi.
Chủ pm hình như cũng chán nốt, hơn 1 năm chả update gì dù Office 2021 đã có.
Em nhớ gần đây em có gặp 1 cái file excel sử dụng lockxls cũng khá hay (hình như có version mới thì phải) tuy nhiên vẫn mò được hihi
 
LockXLS chỉ là trò chỉ trò vớ vẩn thôi, mình nghiên cứu 4-5 hôm là crack được ngay, lên anh em tốt nhất ko lên dùng nó làm gì
 
Web KT
Back
Top Bottom