INIT WINDOW oMainWindow ;
MAIN ;
TITLE "JANELA OCULTA"
ACTIVATE WINDOW oMainWindow NOSHOW
Uso muito para SYSTEMTRAY
Código completo:
ANNOUNCE __HB_EXTERN__
#include "hwgui.ch"
#include "common.ch"
#include "i_winuser.ch"
#include "hbclass.ch"
#define HB_SYMBOL_UNUSED( symbol ) ( symbol := ( symbol ) )
#define NIIF_INFO 0x00000001
#define WM_TASKBAR WM_USER+1043
#define NIIF_INFO 0x00000001
#define NIIF_WARNING 0x00000002
#define NIIF_ERROR 0x00000003
FUNCTION Main()
WITH OBJECT oServidorIP := ClServidorIP():New()
:ServidorIP()
END
RETURN Nil
CREATE CLASS ClServidorIP
PROTECTED :
EXPORTED :
VAR cIpServer AS STRING INIT "127.0.0.1"
VAR lIP AS LOGIC INIT .F.
VAR cFileIni AS STRING INIT Hb_DirBase() + "SERVIDORIP.INI"
VAR c_Port AS STRING INIT "3306"
VAR c_Addr AS STRING INIT ""
VAR c_ComputerName AS STRING INIT Hb_GetEnv("computername")
VAR c_Pasta AS STRING INIT Hb_DirBase()
VAR cVersao AS STRING INIT "Servidor IP (r2020-02)"
VAR cExeName AS STRING INIT SubStr( Hb_ArgV(0), Rat( Hb_Ps(), Hb_ArgV(0) ) + 1 )
VAR nIcon AS INTEGER INIT 1
VAR oMainWindow AS OBJECT INIT Nil
VAR oTrayMenu AS OBJECT INIT Nil
METHOD ServidorIP()
METHOD IniciarServidor( lInicio )
METHOD PararServidor( lSaida )
METHOD Notificar( cMensagem, cTitulo, nIconIndex )
METHOD MudaIcone()
METHOD Muda_Icone( oIconeX, cTexto, cMens1, cMens2, nIconIndex )
METHOD Liga_Timer( oJanela, lLiga )
METHOD Liberar()
METHOD SysWait( nWait )
METHOD DataHora( cSeparador )
METHOD SistemaExecutando( cExeName )
METHOD NomeExecutavel( lPath )
METHOD Verifica_Ip()
METHOD Sair()
ENDCLASS
METHOD ServidorIP()
LOCAL oIcon
PRIVATE oIcon1 := HIcon():AddResource("ICON_1")
PRIVATE oIcon2 := HIcon():AddResource("ICON_2")
PRIVATE oIcon3 := HIcon():AddResource("ICON_3")
PRIVATE oIcon4 := HIcon():AddResource("ICON_4")
oIcon := HIcon():AddResource("ICON_1")
::c_Addr := ::Verifica_Ip()
IF ! Hb_FileExists( ::cFileIni )
Hwg_WriteIni( 'MAIN', 'Desc', ::cVersao, ::cFileIni )
Hwg_WriteIni( 'MAIN', 'Ver', "Versao 2020", ::cFileIni )
Hwg_WriteIni( 'CONFIGURACAO', 'Port', ::c_Port, ::cFileIni )
Hwg_WriteIni( 'CONFIGURACAO', 'Addr', ::c_Addr, ::cFileIni )
Hwg_WriteIni( 'CONFIGURACAO', 'ServidorMariaDB', ::c_ComputerName, ::cFileIni )
Hwg_WriteIni( 'CONFIGURACAO', 'Pasta', ::c_Pasta, ::cFileIni )
Hwg_WriteIni( 'CONFIGURACAO', 'ExeName', ::cExeName, ::cFileIni )
ELSE
Hwg_WriteIni( 'CONFIGURACAO', 'ServidorMariaDB', ::c_ComputerName, ::cFileIni )
Hwg_WriteIni( 'CONFIGURACAO', 'Addr' , ::c_Addr, ::cFileIni )
::c_Port := hwg_GetIni( 'CONFIGURACAO', 'Port', '3306', ::cFileIni )
::c_Pasta := hwg_GetIni( 'CONFIGURACAO', 'Pasta', Hb_DirBase(), ::cFileIni )
::cExeName := hwg_GetIni( 'CONFIGURACAO', 'ExeName', Hb_DirBase(), ::cFileIni )
ENDIF
IF ::SistemaExecutando( ::cExeName )
IF ::c_Pasta <> Hb_DirBase()
hwg_MsgStop("O servidor já está sendo executado, verifique!", "Atenção")
hwg_ExitProcess()
ENDIF
ENDIF
INIT WINDOW ::oMainWindow ;
MAIN ;
TITLE "SERVIDOR IP"
CONTEXT MENU ::oTrayMenu
MENUITEM "Parar o Servidor" ACTION {||::PararServidor()} BITMAP "STOP"
MENUITEM "Reiniciar o Servidor" ACTION {||::IniciarServidor()} BITMAP "START"
MENUITEM "Testar IP" ACTION {||::c_Addr:="127.0.0.1"} BITMAP "IP"
MENUITEM "Compilador" ACTION {||hwg_MsgInfo("Servidor de IP" + ;
Hb_Eol() + ;
Hb_Eol() + ;
Hb_Version() + ;
Hb_Eol() + ;
Hb_Compiler() + ;
Hb_Eol() + ;
Hb_Eol() + ;
"Desenvolvido por Alexandre Simões" + ;
Hb_Eol() + ;
"asimoesluz@gmail.com", "Sobre a Versão do Servidor de IP")} ;
BITMAP "SOBRESIS"
MENUITEM "Versão" ACTION {|| ShowPopUp() } BITMAP "SOBRESIS"
SEPARATOR
MENUITEM "Sair" ACTION ::Sair() BITMAP "SAIR"
ENDMENU
::Liga_Timer( ::oMainWindow, .T. )
::IniciarServidor(.T.)
::oMainWindow:InitTray( oIcon, , ::oTrayMenu, ::cVersao + Hb_Eol() + Hb_Dirbase(), "Iniciado", "Servidor IP" )
ACTIVATE WINDOW ::oMainWindow NOSHOW
::oTrayMenu:End()
RETURN Nil
METHOD Notificar( cMensagem, cTitulo, nIconIndex )
*--------------------------------------------------------*
MEMVAR oIcon1
Hb_Default(@cTitulo, "Servidor IP")
Hb_Default(@cMensagem, "")
Hb_Default(@nIconIndex, NIIF_INFO)
::Muda_Icone( oIcon1, ::cVersao + Hb_Eol() + Hb_DirBase(), cMensagem, cTitulo, nIconIndex )
RETURN Self
METHOD MudaIcone()
LOCAL cIcon
LOCAL c_Addr
LOCAL dDataServer
MEMVAR oIcon1
MEMVAR oIcon2
MEMVAR oIcon3
MEMVAR oIcon4
hwg_DoEvents()
::Liga_Timer( ::oMainWindow, .F. )
IF ::cIpServer != ::Verifica_Ip()
::cIpServer := ::Verifica_Ip()
::lIP := .F.
ENDIF
IF ::cIpServer != "127.0.0.1" .AND. ! ::lIP
::c_Port := hwg_GetIni( 'CONFIGURACAO', 'Port', '3306', ::cFileIni )
::lIP := .T.
Hwg_WriteIni( 'CONFIGURACAO', 'Addr', ::cIpServer, ::cFileIni )
ENDIF
IF ::SistemaExecutando( ::cExeName )
dDataServer := Hb_CtoD( hwg_GetIni( 'CONFIGURACAO', 'Data', '', ::cFileIni ), "DD/MM/YYYY" )
IF dDataServer != Date()
Hwg_WriteIni( 'CONFIGURACAO', 'Data', Hb_DtoC( Date(), "DD/MM/YYYY" ), ::cFileIni )
ENDIF
ENDIF
::nIcon := IF(::nIcon > 4, 1, ::nIcon)
cIcon := 'oIcon' + Hb_NtoS( ::nIcon )
::Muda_Icone( &cIcon., ::cVersao + Hb_Eol() + ::c_Pasta + Hb_Eol() + "\\" + ::cIpServer + ":" + ::c_Port )
::nIcon ++
::Liga_Timer( ::oMainWindow, .T. )
hwg_DoEvents()
RETURN Nil
METHOD Muda_Icone( oIconeX, cTexto, cMens1, cMens2, nIconIndex )
LOCAL oIcon:=oIconeX
Hb_Default(@cMens1, "")
Hb_Default(@cMens2, "")
Hb_Default(@nIconIndex, NIIF_INFO)
hwg_ShellModifyIcon( ::oMainWindow:handle, oIcon:handle, cTexto, cMens1, cMens2, nIconIndex )
::oMainWindow:Refresh()
RETURN Nil
METHOD Liga_Timer( oJanela, lLiga )
THREAD STATIC oTimer
IF lLiga
SET TIMER oTimer of oJanela VALUE 5000 ACTION {|| ::MudaIcone() }
ELSE
oJanela:oTimer:End()
ENDIF
RETURN Nil
METHOD Sair()
LOCAL aProcs:={}, nVezes:=1, nTentativa:=1
::Liga_Timer( ::oMainWindow, .F. )
::Notificar("Encerrado", "Servidor IP")
::SysWait(3)
IF ::SistemaExecutando( ::cExeName )
::PararServidor()
ELSE
::PararServidor(.T.)
ENDIF
DO WHILE .T.
nSucesso := Win_GetProcessList( aProcs, ::cExeName )
IF Len( aProcs ) = 0 .OR. nTentativa > 10
EXIT
ENDIF
aProcs := {}
nTentativa ++
ENDDO
::Liberar()
RETURN Nil
METHOD Liberar()
hwg_EndWindow()
RETURN Nil
METHOD IniciarServidor( lInicio )
LOCAL c_Addr := ::Verifica_Ip()
Hb_Default(@lInicio, .F.)
IF ! lInicio
::Liga_Timer( ::oMainWindow, .F. )
::cIpServer := "127.0.0.1"
::lIP := .F.
ENDIF
IF ::SistemaExecutando( ::cExeName )
::PararServidor()
ENDIF
IF ! ::SistemaExecutando( ::cExeName )
ENDIF
Hwg_WriteIni( 'CONFIGURACAO', 'Addr', c_Addr, ::cFileIni )
Hwg_WriteIni( 'CONFIGURACAO', 'Data', Hb_DtoC( Date(), "DD/MM/YYYY" ), ::cFileIni )
::SysWait(1)
IF ! lInicio
::Liga_Timer( ::oMainWindow, .T. )
ENDIF
RETURN Nil
METHOD PararServidor( lSaida )
Hb_Default(@lSaida, .F.)
::Liga_Timer( ::oMainWindow, .F. )
IF ::SistemaExecutando( ::cExeName )
ENDIF
::SysWait(1)
IF ! lSaida
::Liga_Timer( ::oMainWindow, .T. )
ENDIF
RETURN Nil
METHOD SysWait( nWait )
LOCAL iTime:=Seconds()
Hb_Default(@nWait, 1)
DO WHILE Seconds() - iTime < nWait
hwg_DoEvents()
ENDDO
RETURN Nil
METHOD DataHora( cSeparador )
LOCAL cDataHora
Hb_Default(@cSeparador, ' ')
cDataHora := Hb_TTOC( Hb_DateTime(), 'DD/MM/YYYY', 'HH:MM:SS' )
cDataHora := StrTran( cDataHora, ' ', cSeparador )
RETURN cDataHora
METHOD SistemaExecutando( cExeName )
LOCAL aProcs := {}, lEstaRodando := .F., nVezes := 0
Hb_Default(@cExeName, SubStr( Hb_ArgV(0), Rat( Hb_Ps(), Hb_ArgV(0) ) + 1 ) )
Win_GetProcessList( aProcs, cExeName )
aEval( aProcs, {|x| nVezes++ } )
IF nVezes > 1
lEstaRodando := .T.
ELSE
IF nVezes = 1
lEstaRodando := .T.
ENDIF
ENDIF
RETURN lEstaRodando
METHOD NomeExecutavel( lPath )
LOCAL nPos, cRet
IF Empty( lpath )
nPos := Rat( Hb_Ps(), Hb_Argv(0) )
cRet := SubStr( Hb_Argv(0), nPos + 1 )
ELSE
cRet:= Hb_Argv(0)
ENDIF
RETURN cRet
METHOD Verifica_Ip()
LOCAL aHosts, cEstacao := NetName(.F.), oElemento, cIP := ""
Hb_InetInit()
aHosts := Hb_InetGetHosts( cEstacao )
IF aHosts == Nil
aHosts := Hb_InetGetAlias( cEstacao )
ENDIF
IF Empty(aHosts)
aHosts := Hb_InetGetAlias( cEstacao )
ENDIF
cIP := aHosts[1]
FOR EACH oElemento IN aHosts
IF Left( oElemento, 3 ) != "192"
cIP := oElemento
ENDIF
NEXT
Hb_InetCleanup()
RETURN cIP
INIT FUNCTION Config
REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PTISO
HB_CDPSELECT( "PTISO" )
SET DATE BRITISH
SET CENTURY ON
SET OPTIMIZE ON
REQUEST HB_DATETIME
REQUEST DBFCDX
RddSetDefault("DBFCDX")
RETURN Nil
#pragma ENDDUMP
************************
#pragma BEGINDUMP
#include <windows.h>
#include <windef.h>
#include <tlhelp32.h>
#include <hbapi.h>
#include <hbapiitm.h>
static
BOOL GetUserAndDomainFromPID( DWORD ProcessId, PHB_ITEM pUser, PHB_ITEM pDomain )
{
HANDLE hToken;
HANDLE ProcessHandle;
DWORD cbBuf;
SID_NAME_USE snu;
char *User = NULL;
char *Domain = NULL;
DWORD UserSize = 0L;
DWORD DomainSize = 0L;
BOOL bResult = FALSE;
ProcessHandle = OpenProcess( PROCESS_QUERY_INFORMATION, FALSE, ProcessId );
if (ProcessHandle)
{
if (OpenProcessToken(ProcessHandle, TOKEN_QUERY, &hToken))
{
BOOL bSuccess = FALSE;
PTOKEN_USER ptiUser;
if (!GetTokenInformation(hToken, TokenUser, NULL, 0, &cbBuf ))
{
ptiUser = (TOKEN_USER *) hb_xgrab( cbBuf );
bSuccess = GetTokenInformation( hToken, TokenUser, (LPVOID) ptiUser, cbBuf, &cbBuf);
}
CloseHandle(hToken);
if (bSuccess)
{
LookupAccountSid( NULL, ptiUser->User.Sid, NULL, &UserSize, NULL, &DomainSize, &snu);
if (UserSize != 0 && DomainSize != 0)
{
User = (char *) hb_xgrab( UserSize );
Domain = (char *) hb_xgrab( DomainSize );
if (LookupAccountSid( NULL, ptiUser->User.Sid, User, &UserSize,
Domain, &DomainSize, &snu))
{
/* Result OK */
bResult = TRUE;
}
}
}
if (ptiUser)
hb_xfree( ptiUser );
}
CloseHandle(ProcessHandle);
}
if (!User)
hb_itemPutC( pUser, "" );
else
hb_itemPutCLPtr( pUser, User, UserSize );
if (!Domain)
hb_itemPutC( pDomain, "" );
else
hb_itemPutCLPtr( pDomain, Domain, DomainSize );
return bResult;
}
/*
* WIN_GETPROCESSLIST( aArray [, <cProcessToFind> ] ) -> nResult
* Get current process list on Windows OS. by Vailton Renato <vailtom@gmail.com>
*
* Returns:
*
* 0 - Success
* 1 - Argument error
* 2 - Unable to obtain current process list.
* 3 - Error retrieving information about processes.
*
* 15/12/2009 - 18:58:58
*/
HB_FUNC( WIN_GETPROCESSLIST )
{
HANDLE hProcessSnap;
PROCESSENTRY32 pe32;
PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY );
const char * szAppName = hb_parcx(2);
BOOL bCanAdd = TRUE;
if( !pArray )
{
hb_retni( 1 );
return;
}
// Take a snapshot of all processes in the system.
hProcessSnap = CreateToolhelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
if( hProcessSnap == INVALID_HANDLE_VALUE )
{
// CreateToolhelp32Snapshot (of processes)
hb_retni( 2 );
return;
}
// Set the size of the structure before using it.
pe32.dwSize = sizeof( PROCESSENTRY32 );
// Retrieve information about the first process,
// and exit if unsuccessful
if( !Process32First( hProcessSnap, &pe32 ) )
{
hb_retni( 3 );
CloseHandle( hProcessSnap ); // clean the snapshot object
return;
}
// Ignores a empty string on seconds argument
if ( hb_parclen(2) < 1 )
szAppName = NULL;
// Now walk the snapshot of processes, and
// display information about each process in turn
do
{
PHB_ITEM pSubarray;
if (szAppName)
bCanAdd = ( hb_stricmp( szAppName, pe32.szExeFile ) == 0 );
if (bCanAdd)
{
pSubarray = hb_itemNew( NULL );
hb_arrayNew( pSubarray, 5 );
hb_arraySetC ( pSubarray, 1, pe32.szExeFile ); // Process Name
hb_arraySetNInt ( pSubarray, 2, pe32.th32ProcessID ); // Process ID
hb_arraySetNInt ( pSubarray, 3, pe32.th32ParentProcessID ); // Parent process ID
GetUserAndDomainFromPID( pe32.th32ProcessID,
hb_arrayGetItemPtr( pSubarray, 4 ), // User
hb_arrayGetItemPtr( pSubarray, 5 ) ); // Domain
hb_arrayAddForward( pArray, pSubarray );
}
} while( Process32Next( hProcessSnap, &pe32 ) );
CloseHandle( hProcessSnap );
hb_retni( 0 );
return;
}
/*
* WIN_KILLPROCESS( <nProessIDtoKill> ) -> lKilled
* Kill a process using Win32 API. by Vailton Renato <vailtom@gmail.com>
* 16/12/2009 - 00:08:48
*/
HB_FUNC( WIN_KILLPROCESS )
{
DWORD ProcID;
BOOL Result = FALSE;
if (HB_ISNUM(1))
{
ProcID = (DWORD) hb_parnl(1);
Result = TerminateProcess(OpenProcess( PROCESS_TERMINATE, FALSE, ProcID ),0);
}
hb_retl( Result );
}
#pragma ENDDUMP
#pragma BEGINDUMP
#include <windows.h>
#include <hbapi.h>
HB_FUNC( GETFILEVERSIONINFO )
{
char * szFile = hb_parc( 1 );
UINT uAction = HB_ISNUM( 2 ) ? hb_parni( 2 ) : 1;
DWORD dwHandle = 0;
DWORD dwSize = GetFileVersionInfoSize( szFile, &dwHandle );
char * szOut = NULL;
BOOL bOk = FALSE;
if( dwSize )
{
char * szBlock = ( char * ) hb_xgrab( 255 );
char * szSubBlock = ( char * ) hb_xgrab( 255 );
HGLOBAL hMem = GlobalAlloc( GMEM_MOVEABLE, dwSize );
VS_FIXEDFILEINFO * vsInfo;
UINT nLen = 0;
if( hMem )
{
LPVOID pMem = GlobalLock( hMem );
if( pMem && GetFileVersionInfo( szFile, dwHandle, dwSize, pMem ) )
{
if( VerQueryValue( pMem, "\\VarFileInfo\\Translation", ( LPVOID * ) &vsInfo, &nLen ) )
{
*( LPDWORD ) vsInfo = MAKELONG( HIWORD( *( LPDWORD ) vsInfo ), LOWORD( *( LPDWORD ) vsInfo ) );
sprintf( szBlock, "\\StringFileInfo\\%08lx\\", *( LPDWORD )( vsInfo ) );
switch( uAction ) {
case 1:
sprintf( szSubBlock, "%s%s", szBlock, "Comments" );
break;
case 2:
sprintf( szSubBlock, "%s%s", szBlock, "CompanyName" );
break;
case 3:
sprintf( szSubBlock, "%s%s", szBlock, "FileDescription" );
break;
case 4:
sprintf( szSubBlock, "%s%s", szBlock, "FileVersion" );
break;
case 5:
sprintf( szSubBlock, "%s%s", szBlock, "InternalName" );
break;
case 6:
sprintf( szSubBlock, "%s%s", szBlock, "LegalCopyright" );
break;
case 7:
sprintf( szSubBlock, "%s%s", szBlock, "LegalTrademarks" );
break;
case 8:
sprintf( szSubBlock, "%s%s", szBlock, "OriginalFilename" );
break;
case 9:
sprintf( szSubBlock, "%s%s", szBlock, "PrivateBuild" );
break;
case 10:
sprintf( szSubBlock, "%s%s", szBlock, "ProductName" );
break;
case 11:
sprintf( szSubBlock, "%s%s", szBlock, "ProductVersion" );
break;
case 12:
sprintf( szSubBlock, "%s%s", szBlock, "SpecialBuild" );
break;
case 13:
sprintf( szSubBlock, "%s%s", szBlock, "AditionalNotes" );
break;
}
if( VerQueryValue( pMem, szSubBlock, ( LPVOID * ) &szOut, &nLen ) )
bOk = TRUE;
hb_xfree( szBlock );
hb_xfree( szSubBlock );
}
GlobalUnlock( hMem );
GlobalFree( hMem );
}
}
}
if( bOk )
hb_retc( szOut );
else
hb_retc( "" );
}
HB_FUNC( WIN_N2PP )
{
hb_retptr( ( void * ) ( HB_PTRDIFF ) hb_parnint( 1 ) );
}
#pragma ENDDUMP