by Hector Marquez (1 Submission)
Category: Windows API Call/Explanation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 21st November 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Elimina el mensaje de Seagate Crystal Reports 8.0 "Se requiere licencia de ejecuci¨n". It eliminates the Seagate Crystal Reports 8.0 message
API Declarations
' Antes del codigo en el que sale el mensaje de la licencia ejecutar el programa.
' Shell App.Path & "\CrackSgRpt.exe", vbHide
'Constantes y declaraciones necesarias para el acceso al registro de windows.
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_NULL = &H0
Public Const WM_SETFOCUS = &H7
Public Const GW_CHILD = 5
Public Const VK_RETURN& = &HD
Public Const KEYEVENTF_KEYUP% = &H2
Public Const VK_MENU& = &H12
Public Const VK_DOWN& = &H28
Public Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetClassName& Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long)
Public Declare Sub SetForegroundWindow Lib "user32" (ByVal hwnd As Long)
Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'// Declaraciones Ejecucion Sincrona de programas
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
VBcoders
Dim Espera As Integer
Espera = 10
On Error Resume Next
Espera = CInt(Trim(Command()))
If Espera = 0 Then Espera = 10
If Espera > 60 Then Espera = 60
CrackSgRpt Espera
End Sub
Public Function CrackSgRpt(Optional WaitSg As Integer = 10) As Boolean
Dim hShell As Double
Dim hProc As Long
Dim codExit As Long
Dim sCmd As String
Dim SgRptHwnd As Long
Dim sCaption As String
Dim RetSMsg As Long
Dim hButton As Long
Dim hChildFrm As Long
Dim CurTime As Date
Dim SpendTime As Integer
Dim sCurDir As String
Dim sCurDrive As String
Dim PulsarALT As Long
Dim sFileName As String
On Error GoTo ControlError
CrackSgRpt = True
DoEvents
sCaption = "Se requiere licencia de ejecución"
CurTime = Time()
Do
DoEvents
SgRptHwnd = FindWindow(vbNullString, sCaption)
SpendTime = DateDiff("s", CurTime, Time())
Loop While SgRptHwnd = 0 And SpendTime < WaitSg
If SpendTime > 10 Then
CrackSgRpt = False
Exit Function
End If
' Primero Encontrar Ventana de la aplicacion
CurTime = Time()
Do
DoEvents
SgRptHwnd = FindWindow(vbNullString, sCaption)
SpendTime = DateDiff("s", CurTime, Time())
Loop While SgRptHwnd = 0 And SpendTime < 10
If SpendTime > 10 Or SgRptHwnd = 0 Then
CrackSgRpt = False
Exit Function
End If
' Se le pone el Foco
DoEvents
SetForegroundWindow SgRptHwnd
' Se marca la casilla para que no salte en esta sesión
keybd_event Asc("D"), 0, 0, 0
DoEvents
keybd_event Asc("D"), 0, KEYEVENTF_KEYUP, 0
DoEvents
' Poner foco al boton
hButton = GetDlgItem(SgRptHwnd, 1)
RetSMsg = SendMessageLong(SgRptHwnd, WM_SETFOCUS, 0, 0)
DoEvents
CurTime = Time()
Do
DoEvents
hButton = GetDlgItem(SgRptHwnd, 1)
SpendTime = DateDiff("s", CurTime, Time())
Loop While hButton <> 0 And SpendTime < 0.5
RetSMsg = SendMessageLong(hButton, WM_KEYDOWN, &H20, &H1) ' Pulsar el boton Continuar
DoEvents
hButton = GetDlgItem(SgRptHwnd, 1)
RetSMsg = SendMessageLong(hButton, WM_KEYUP, &H20, &H1)
DoEvents
ControlError:
If Not Err = 0 Then
CrackSgRpt = False
Select Case Err
Case Else
End Select
End If
End Function
Public Function FindChildByClass(ParentW As Long, ChildHand As String)
Dim Firs As Long
Dim Firss As Long
Dim Room As Long
Firs = GetWindow(ParentW, 5)
If UCase(Mid(GetClass(Firs), 1, Len(ChildHand))) Like UCase(ChildHand) Then GoTo bone
Firs = GetWindow(ParentW, GW_CHILD)
If UCase(Mid(GetClass(Firs), 1, Len(ChildHand))) Like UCase(ChildHand) Then GoTo bone
While Firs
Firss = GetWindow(ParentW, 5)
If UCase(Mid(GetClass(Firss), 1, Len(ChildHand))) Like UCase(ChildHand) Then GoTo bone
Firs = GetWindow(Firs, 2)
If UCase(Mid(GetClass(Firs), 1, Len(ChildHand))) Like UCase(ChildHand) Then GoTo bone
Wend
FindChildByClass = 0
bone:
Room = Firs
FindChildByClass = Room
End Function
Public Function GetClass(CHILD)
Dim buffer As String
Dim GetClas As Long
buffer = String$(250, 0)
GetClas = GetClassName(CHILD, buffer, 250)
GetClass = buffer
End Function
No comments have been posted about Elimina el mensaje de Seagate Crystal Reports 8.0 Se requiere licencia de ejecuci¨n. It eliminate. Why not be the first to post a comment about Elimina el mensaje de Seagate Crystal Reports 8.0 Se requiere licencia de ejecuci¨n. It eliminate.
