Funções com API do Windows

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

TerraSoftware
Usuário Nível 3
Usuário Nível 3
Mensagens: 353
Registrado em: 28 Jul 2004 13:14
Localização: Cianorte-PR
Contato:

Funções com API do Windows

Mensagem por TerraSoftware »

Caro colegas, neste novo topico iremos ser mais especificos sobre o assunto.

Código: Selecionar todos

procedure main()
// exemplo 1
StatusExe("ACBrMonitor.exe",2)
inkey(1)
MoveMouse()
winexec("C:\ACBrMonitor\ACBrMonitor.exe")
// exemplo 2
if StatusExe("ACBrMonitor.exe",1)=.f.
   winexec("C:\ACBrMonitor\ACBrMonitor.exe")
endif
quit
Segue as funcoes

Código: Selecionar todos

************************************
function StatusExe(cExecutavel,oque)
************************************
Local oWmiService, oListaProcess, oProcessos, nNome, Proreti:=.f.
oWmiService=Service_WMI()
oListaProcess=oWmiService:ExecQuery("select * from Win32_Process where Name='"+cExecutavel+"'")
For Each oProcessos in oListaProcess
    Proreti:=.t.
    if oque=2
       oProcessos:Terminate()
    endif
Next
return(Proreti)

**********************
Function Service_WMI()
**********************
Static oWmiService 
Local oScriptObj
If oWmiService==nil
   oScriptObj=CREATEOBJECT("wbemScripting.SwbemLocator")
   oWmiService=oScriptObj:ConnectServer()
End If
Return oWmiService

************************
#pragma BEGINDUMP
#include <windows.h>
#include <windef.h>

VOID MoveMouse();
HB_FUNC( MOVEMOUSE )
{
    POINT Cursor;
    RECT TrayRect;
    GetWindowRect(FindWindowEx(FindWindow("Shell_TrayWnd",NULL),0,"TrayNotifyWnd",NULL),&TrayRect);

    GetCursorPos(&Cursor);

    while(TrayRect.left+11 < TrayRect.right) {
        SetCursorPos(TrayRect.left+10,TrayRect.top+12);
        Sleep(1);
        TrayRect.left += GetSystemMetrics(SM_CXSMICON)+2;
    }
    SetCursorPos(Cursor.x,Cursor.y);
}
#pragma ENDDUMP
***********************
Explicando:
A funcao StatusExe tem 2 parametros
1º - String, nome do executavel que se quer finalizar e/ou consultar, nao precisa do path inteiro
2º - Numérico, onde 1 é para apenas consultar se o executavel esta em execuçao ou nao, se estiver, a funcao retorna verdadeiro, e falso do contrario. E 2 para finalizar o executavel se ele estiver sendo executado.
A funcao winexec é nativa na hwgui, nao tenho o fonte dela, mas é muito facil encontra-la aqui mesmo neste forum. Ela serve para executar qualquer programa que se saiba o nome do executavel, é necessário o path inteiro.
A funcao MoveMouse serve para dar um "refresh" no tray do windows, se for necessário, é claro.

Problema:
A funcao StatusExe quando chamada com o segundo parametro igual a 2, finaliza o executavel mencionado no primeiro parametro, em todas as sessoes do windows que estiver aberta. Quem trabalha como Terminal Server CUIDADO. Eu ainda continuo com este problema, se alguem puder ajudar agradeço.

Créditos:
rmg, Maligno e Sygecom
www.sisterra.com.br
xHarbour 1.0.0 - Bcc 6.3 - Gtwvw/Hwgui
DbfCdx/MySql
Avatar do usuário
vailton
Colaborador
Colaborador
Mensagens: 390
Registrado em: 17 Nov 2005 19:08
Localização: Brasil
Contato:

Re: Finalizando Aplicativo Windows

Mensagem por vailton »

Isto funciona no Windows 98 ou você nem chegou a testar? Pois tenho a impressão que este código só irá rodar no XP para frente... estou certo?
Vailton Renato
"No dia mais claro, na noite mais escura... o bug sucumbirá ante a minha presença"

E-mail/MSN: contato@vailton.com.br
Skype: vailtom
Avatar do usuário
Maligno
Membro Master
Membro Master
Mensagens: 6398
Registrado em: 06 Jul 2004 01:40
Localização: Londrina/PR

Re: Finalizando Aplicativo Windows

Mensagem por Maligno »

De acordo com o MSDN, a função que passei, MouseMove(), funcionará do Win95 pra frente.

Aliás, uma curiosidade: qual a finalidade desse "pragma BEGINDUMP/ENDDUMP"? Parece coisa de debugging. Precisa?
[]'s
Maligno
---
Não respondo questões técnicas através de MP ou eMail. Não insista.
As dúvidas devem ser postadas no fórum. Desta forma, todos poderão
se beneficiar das respostas.

---
Se um dia precisar de uma transfusão de sangue você perceberá como
é importante a figura do doador. Procure o hemocentro de sua cidade e
se informe sobre a doação de sangue, plaquetas e medula óssea. Doe!
Avatar do usuário
vailton
Colaborador
Colaborador
Mensagens: 390
Registrado em: 17 Nov 2005 19:08
Localização: Brasil
Contato:

Re: Finalizando Aplicativo Windows

Mensagem por vailton »

Maligno escreveu:De acordo com o MSDN, a função que passei, MouseMove(), funcionará do Win95 pra frente.
Aliás, uma curiosidade: qual a finalidade desse "pragma BEGINDUMP/ENDDUMP"? Parece coisa de debugging. Precisa?
O código que suspeito só rodar em kernels baseados no NT é referente à funcao Service_WMI(). E no caso os pragmas supra citados são para quando você precisa mesclar em um mesmo .PRG rotinas em C puro com rotinas xBase. O pessoal do Harbour não incentiva mais este tipo de prática, pois eles promovem a limpeza e clareza de código, mas eu mesmo uso muito aqui na empresa pois pode-se quebrar uns galhos rápidos devido à sua praticidade.
Vailton Renato
"No dia mais claro, na noite mais escura... o bug sucumbirá ante a minha presença"

E-mail/MSN: contato@vailton.com.br
Skype: vailtom
Avatar do usuário
vailton
Colaborador
Colaborador
Mensagens: 390
Registrado em: 17 Nov 2005 19:08
Localização: Brasil
Contato:

Re: Finalizando Aplicativo Windows

Mensagem por vailton »

Com base nos comentários dos amigos que li nas referências deste post eu dei uma pesquisada e esbocei algumas funções que servem para listar todos os processos em uso na CPU (informando PID, PPID, nome do usuario & domain do mesmo) e outra que permite terminar um processo que esteja rodando com base no seu numero de processo.

Não ficou 100% por que a função pelo que testei aqui no meu Windows Vista só consegue puxar o nome do usuário da sessão atual e embora mostre os processos de todos os usuarios, não me mostra seus nomes. Mas eu acho que pelo que o TerraSoftware comentou, isto já possa ser de alguma ajuda.

Att,
Vailton Renato

Código: Selecionar todos

* Routines to Kill a process, List all processes WITH user & domain names.
* by Vailton Renato <vailtom@gmail.com> to Public Domain.
*
* UPDATED: 16/12/2009 - 12:15
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
* FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL NORMAN WALSH OR
* ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
* CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*
procedure main()
   LOCAL cApp
   LOCAL i
   LOCAL n

   CLS

   ACCEPT 'Type process name to find (like CALC.EXE): ' TO cApp
   aProcs := {}

   if !empty( cApp ) .and. !( '.' $ cApp )
      cApp += '.exe'
   end

   n := WIN_GETPROCESSLIST( aProcs, cApp )

   ?
   ? 'WIN_GETPROCESSLIST( {}, "' + cApp + '" ) ->', n

   DO CASE
   CASE n == 0 ;  ?? ' - Success'
   CASE n == 1 ;  ?? ' - Argument error!'
   CASE n == 2 ;  ?? ' - Unable to obtain current process list!'
   CASE n == 3 ;  ?? ' - Error retrieving information about processes!'
   End

   aSort( aProcs ,,, {|x,y| x[1] < y[1] })

   ?
   ? 'Process Name          Process ID   ParentID   UserName (with Domain)'
   ? '====================  ==========   ========   ======================'
    * 123456789*123456789*  123456789*   12345678   123456789*123456789*

   For i := 1 TO Len( aProcs )
      ? PADR( aProcs[i,1], 21),;
        aProcs[i,2], ;
        aProcs[i,3], '  '

      IF Empty(aProcs[i,5]) .AND. Empty( aProcs[i,4] )
         *
      ELSE
        ?? '\\' + aProcs[i,5]+'\'+ aProcs[i,4]
      End
   End

   ? len(aProcs), ' process found!'
   ?

   IF Upper(cApp) == 'CALC.EXE' .AND. !Empty( aProcs )

      p := Atail(aProcs)[ 2 ]

      IF Alert( 'You want to kill the process number ' + alltrim(str(p)) + '?',;
            {'No','Yes'} ) == 2
         ?
         ? 'Kill Calc.exe, PID:', p, " -->  "
         ?? WIN_KILLPROCESS( p )
         ?
      End
   End

   QUIT

************************
#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 (ISNUM(1))
   {
      ProcID = (DWORD) hb_parnl(1);
      Result = TerminateProcess(OpenProcess( PROCESS_TERMINATE, FALSE, ProcID ),0);
   }

   hb_retl( Result );
}

#pragma ENDDUMP
Editado pela última vez por vailton em 16 Dez 2009 12:16, em um total de 1 vez.
Vailton Renato
"No dia mais claro, na noite mais escura... o bug sucumbirá ante a minha presença"

E-mail/MSN: contato@vailton.com.br
Skype: vailtom
Avatar do usuário
vailton
Colaborador
Colaborador
Mensagens: 390
Registrado em: 17 Nov 2005 19:08
Localização: Brasil
Contato:

Re: Finalizando Aplicativo Windows

Mensagem por vailton »

Eu fiz um teste com este exemplo agora pela manhã com MSVC e notei que havia uma warning que alertava sobre um possivel erro de lógica. Aproveitei e consultei o MSDN e atualizei o código acima que rodou perfeitamente com BCC e MSVC numa boa. Sobre o problema citado de pegar o nome dos usuarios que estao rodando processos em outros logins ao mesmo tempo, acho que isto deve ter relação com o UAC e deve requerer elevação de privilégios do processo que deseja consultar a informação, mas nao sei como fazer e nem sei se compensa...

Entao de qqer forma o código está completo e atualizado aê em cima para todos.

Abraços,
Vailton Renato
"No dia mais claro, na noite mais escura... o bug sucumbirá ante a minha presença"

E-mail/MSN: contato@vailton.com.br
Skype: vailtom
Avatar do usuário
fladimir
Colaborador
Colaborador
Mensagens: 2445
Registrado em: 15 Nov 2006 20:21

Re: Finalizando Aplicativo Windows

Mensagem por fladimir »

Legal Colegas, obrigado pela contribuição, as informações aki contidas irão resolver umas questões necessárias...

Grato e Sucesso!!!

:)Pos
Sun Tzu há mais de três mil anos cita nas epígrafes de seu livro “A Arte da Guerra“:

“Concentre-se nos pontos fortes, reconheça as fraquezas, agarre as oportunidades e proteja-se contra as ameaças”.
“Se não é vantajoso, nunca envie suas tropas; se não lhe rende ganhos, nunca utilize seus homens; se não é uma situação perigosa, nunca lute uma batalha precipitada”
.


Até 2017    Desktop Console [ Legado ] Harbour | MinGW | DBF | CDX | FastReport | MySQL


Novos Projetos:

   Desktop Visual           Windev Desktop
   Celular Android/iOS   Windev Mobile
   WEB                            Windev Web


Sejamos gratos a Deus.
TerraSoftware
Usuário Nível 3
Usuário Nível 3
Mensagens: 353
Registrado em: 28 Jul 2004 13:14
Localização: Cianorte-PR
Contato:

Re: Finalizando Aplicativo Windows

Mensagem por TerraSoftware »

Caros colegas.
Finalmente fiz testes no win98, realmente nao funciona, o Vailton estava certo. A funcao Service_WMI só funciona em kernel NT.
A funcao movemouse nao apresenta erro no win98, embora nao obtem o resultado desejado.

Mas... vamos falar a verdade... usar win98 ou menor é duro né... já faz quase 12 anos... Nossos clientes precisam evoluir... nós estamos indo pra frente e temos que leva-los juntos.

Para o meu software nao ficar preso ao kernel NT faço o seguinte:

Código: Selecionar todos

***********************************
function QualquerCoisaSoNT()
***********************************
if os_iswinnt()
   isso igual a aquilo
   vai pra la
   vem pra ka
   bla bla bla
endif
return
Ou seja, só executo a funcao se o OS for kernel NT.
www.sisterra.com.br
xHarbour 1.0.0 - Bcc 6.3 - Gtwvw/Hwgui
DbfCdx/MySql
SAOliveira
Usuário Nível 1
Usuário Nível 1
Mensagens: 3
Registrado em: 27 Set 2012 15:33
Localização: Lins/SP

Finalizando Aplicativo Windows

Mensagem por SAOliveira »

Aproveitando.

Teriam algo que alem de verificar se o .EXE está aberto, tambem pegar a Caption do mesmo.
SAOliveira
FiveWin/xHB
"O silêncio é o argumento mais difícil de se rebater."
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Finalizando Aplicativo Windows

Mensagem por Pablo César »

Seja bem vindo ao fórum !
SAOliveira escreveu:Teriam algo que alem de verificar se o .EXE está aberto, tambem pegar a Caption do mesmo.
Como assim o caption ? Você quis dizer: trazer a janela em foco ?

Se for isso, o WAPI.EXE possue uma opção -GETAPPSINFO de listar todas as janelas e aplicativos que estão abertos com o número de cada handle, que será necessário para recuperar. Podendo ser direcionado em arquivo, as funções foram feitas em C. Eu não sei se você precisa uma solução em Harbour ou em Clipper. A utilização do WAPI pode ser utilizada como biblioteca do Clipper.

Uma vez tendo o handle da sessão que deseja trazer pra frente, você pode utilizar:

Código: Selecionar todos

FUNCTION PraFrente( hWnd, nBlinks )
If IsIconic( VAL(Left(cLine,i-1)) )
   FlashWindow( hWnd, nBlinks, .T. )
Endif
IF IsIconic( hWnd )
   Restore( hWnd )
ELSE
   SetForeGroundWindow( hWnd )
ENDIF
RETURN Nil


#pragma BEGINDUMP

#define HB_OS_WIN_USED
#define _WIN32_WINNT   0x0400
#include <windows.h>
#include "hbapi.h"
#include "hbapiitm.h"

HB_FUNC( ISICONIC )
{
   hb_retl( IsIconic( ( HWND ) hb_parnl( 1 ) ) );
}

HB_FUNC ( FINDWINDOW )
{
   hb_retnl( ( LONG ) FindWindow( 0, hb_parc( 1 ) ) );
}

HB_FUNC( FLASHWINDOW )
{
   FLASHWINFO fi;

   fi.cbSize = sizeof( fi );
   fi.hwnd = (HWND) hb_parnl( 1 );
   fi.uCount = hb_parnl( 2 );
   fi.dwFlags = FLASHW_ALL;
   fi.dwTimeout = hb_parl( 3 ) ? 200 : 0;

   FlashWindowEx( &fi );
}

#pragma ENDDUMP
Um dos exemplos da MINIGUI em C:\MiniGUI\SAMPLES\Advanced\GoStop\GoStop.prg pode dar uma ideia de como adaptar o seu código em Harbour para detectar o executável que possa estar sendo executado. Anexei o aplicativo com seu fonte para apreciação.
Anexos
GoStop.rar
(433.91 KiB) Baixado 193 vezes
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
SAOliveira
Usuário Nível 1
Usuário Nível 1
Mensagens: 3
Registrado em: 27 Set 2012 15:33
Localização: Lins/SP

Finalizando Aplicativo Windows

Mensagem por SAOliveira »

Pablo, na realidade não soube me explicar.

No seu exemplo, quando abre, a barra de titulo aparece "Go Stop" .

O que eu queria, era pegar o "Go Stop" do programa que eu verificar se esta em uso.

StatusExe("GoStopr.exe",2), e poder pgar o titulo "Go Stop"
SAOliveira
FiveWin/xHB
"O silêncio é o argumento mais difícil de se rebater."
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Finalizando Aplicativo Windows

Mensagem por Pablo César »

Acredito que você poderia tentar trazer a janela do aplicativo x através do o handle do processo e consequentemente guardar o título da janela (acho que é isso que você quer). Em HMG/Minigui eu faria:

cTitulo:=This.Title

Mas isso uma vez que tenho a janela no foco. Na minha mensagem anterior tem as duas opções: uma quando estiver iconizada e outra quando estiver aberta mas fora de foco. Utilizando as funções em C tais como: Restore( hWnd ) e SetForeGroundWindow( hWnd )
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
Mário Isa
Usuário Nível 4
Usuário Nível 4
Mensagens: 907
Registrado em: 07 Jul 2004 13:54
Localização: Ilha Solteira-sp

Finalizando Aplicativo Windows

Mensagem por Mário Isa »

sabe dizer se tem algum substituto em xhb ao comando
-GETAPPSINFO
com wapi.exe ?

ou seja, em vez de utilizar wapi.exe -getappsinfo:umarquivo.txt

alguma função em C prá colocar no xhb ?
Mario
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Finalizando Aplicativo Windows

Mensagem por Pablo César »

No prg do View_Build_Log tem uma função Func_GetAppInfo em C que é o mais parecido do APPINFO do Wapi.
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
Mário Isa
Usuário Nível 4
Usuário Nível 4
Mensagens: 907
Registrado em: 07 Jul 2004 13:54
Localização: Ilha Solteira-sp

Finalizando Aplicativo Windows

Mensagem por Mário Isa »

Pablo se vc se refere a este prg:

Código: Selecionar todos

*************************************************************************************
* PROGRAMA...........:  View File BUILD.LOG (IDE HMG)
* LINGUAGEM..........:  HARBOUR-MINIGUI 3.0.29
* DATA...............:  6 MAIO 2010 / Revisado em 9 de Nov 2012 por Pablo César
* AUTOR..............:  CLAUDIO SOTO
* PAIS...............:  URUGUAY
* E-MAIL.............:  srvet@adinet.com.uy
* Topico no Forum HMG:  http://hmgforum.com/viewtopic.php?f=15&t=1411&start=20
*************************************************************************************

#include <hmg.ch>

#define CRLF            Chr(13)+Chr(10)
#define YES_LOGFILE     "Sim"
#define NO_LOGFILE      "Não"
#define F_DATE          3
#define F_TIME          4

Function Main()
Set Century On
Set Date to British
REQUEST HB_CODEPAGE_PTISO

PRIVATE FileLog := "Build.log"
PRIVATE ProjectExt := "hbp"

PRIVATE Path  := ""
PRIVATE Filtro := {{"FILE: "+FileLog,FileLog}}
PRIVATE Filter_msg := .F.
PRIVATE Info_Search := ASORT(GET_LINKS(ProjectExt),,, { |x, y| DtoS(CtoD(SubStr(x[1],1,10)))+SubStr(x[1],11,10) > DtoS(CtoD(SubStr(y[1],1,10)))+SubStr(y[1],11,10) })

PRIVATE Text_All  := ""
PRIVATE Path_work := ""
PRIVATE mat1:={}, mat2:={}
PRIVATE flag_changue := .F.

// SET LANGUAGE TO PORTUGUESE

DEFINE WINDOW Form_1; 
    AT 0,0 WIDTH 640 HEIGHT 580;
    TITLE "Visualização do arquivo BUILD.LOG (IDE HMG)";
    FONT "Arial" SIZE 10;
    ICON "SYSTEM";
    MAIN NOSIZE NOMAXIMIZE
	
	ON KEY ESCAPE ACTION Thiswindow.Release()
                     
    DEFINE TAB Tab_1; 
       AT 10 , 10; 
       WIDTH  610;
       HEIGHT 450 
       
       DEFINE PAGE "Projetos do HMG Recentes"
			DEFINE CHECKBOX ChkBox_2
                ROW    048
                COL    020
                WIDTH  225
                HEIGHT 28
                CAPTION " Extensão do arquivo de projeto:"
                VALUE .F.
                FONTNAME "Arial"
                FONTSIZE 10
                TOOLTIP ""
                ONCHANGE {|| form_1.txtBox_2.Enabled := form_1.chkBox_2.value}
                ONGOTFOCUS Nil
                ONLOSTFOCUS Nil
                FONTBOLD .T.
                FONTITALIC .F.
                FONTUNDERLINE .F.
                FONTSTRIKEOUT .F.
                BACKCOLOR Nil
                FONTCOLOR Nil
                HELPID Nil
                TABSTOP .T.
                VISIBLE .T.
                TRANSPARENT .F.
            END CHECKBOX
			
			DEFINE TEXTBOX txtBox_2
                ROW 052
                COL 254
				WIDTH 50
                HEIGHT 21
				VALUE ProjectExt
				ONCHANGE {|| ProjectExt := form_1.txtBox_2.Value}
				FONTNAME "MS Sans Serif"
				FONTSIZE 10
				DISABLEDFONTCOLOR {000,000,255}
				DISABLEDBACKCOLOR {255,255,190}
				BACKCOLOR {000,000,255}
                FONTCOLOR {255,255,190}
				FONTBOLD .T.
                READONLY .T.
				VSCROLLBAR .F.
                HSCROLLBAR .F.
            END EDITBOX
             
            PRIVATE fColor := {|| if (Form_1.Grid_1.Cell(This.CellRowIndex,4) = YES_LOGFILE,{0,0,255},{255,0,0})}
            PRIVATE bColor := {|| {255,255,190}}
             
            @ 100, 10 GRID Grid_1; 
                WIDTH 580; 
                HEIGHT 300;
                HEADERS {"Data/Hora","Projeto","Pasta","Arquivo Log"};
                WIDTHS  {140,220,400,110}; 
                ITEMS Info_Search;
				VALUE 1;
				BACKCOLOR {255,255,190};
				ON CHANGE Hay_Log(This.Value);
				ON DBLCLICK Open_FileLog();
                ON HEADCLICK {{|| Sort_Info_Search(1)},{|| Sort_Info_Search(2)},{|| Sort_Info_Search(3)},{|| Sort_Info_Search(4)}};
                DYNAMICFORECOLOR {fColor , fColor, fColor, fColor};
                DYNAMICBACKCOLOR {bColor , bColor, bColor, bColor};
				JUSTIFY	{ GRID_JTFY_LEFT, GRID_JTFY_LEFT, GRID_JTFY_LEFT, GRID_JTFY_CENTER }
                      
             @ 410, 130 BUTTON Boton_3 CAPTION " Atualizar Lista " BOLD ACTION (GET_LINKS(ProjectExt),Show_Link(ProjectExt)) WIDTH 130 HEIGHT 28
             @ 410, 360 BUTTON Boton_4 CAPTION " Visualizar Arquivo " BOLD ACTION Open_FileLog() WIDTH 130 HEIGHT 28
       END PAGE
       
       DEFINE PAGE "Visualização"
	        DEFINE CHECKBOX ChkBox_1
                ROW    048
                COL    020
                WIDTH  190
                HEIGHT 28
                CAPTION " Nome do arquivo de LOG:"
                VALUE .F.
                FONTNAME "Arial"
                FONTSIZE 10
                TOOLTIP ""
                ONCHANGE {|| Form_1.txtBox_1.Enabled := Form_1.ChkBox_1.value}
                ONGOTFOCUS Nil
                ONLOSTFOCUS Nil
                FONTBOLD .T.
                FONTITALIC .F.
                FONTUNDERLINE .F.
                FONTSTRIKEOUT .F.
                BACKCOLOR Nil
                FONTCOLOR Nil
                HELPID Nil
                TABSTOP .T.
                VISIBLE .T.
                TRANSPARENT .F.
            END CHECKBOX
            
			DEFINE TEXTBOX txtBox_1
                ROW 052
                COL 210
				WIDTH 102
                HEIGHT 21
				VALUE FileLog
				ONCHANGE {|| FileLog := form_1.txtBox_1.value, Filtro := {{"FILE: "+FileLog,FileLog}}}
				FONTNAME "MS Sans Serif"
				FONTSIZE 10
				DISABLEDFONTCOLOR {000,000,255}
				DISABLEDBACKCOLOR {255,255,190}
				BACKCOLOR {000,000,255}
                FONTCOLOR {255,255,190}
				FONTBOLD .T.
                READONLY .T.
				VSCROLLBAR .F.
                HSCROLLBAR .F.
            END EDITBOX
			
			DEFINE CHECKBOX ChkBox_3
                ROW    048
                COL    326
                WIDTH  260
                HEIGHT 28
                CAPTION " Filtro: Exibir somente Erros e Avisos"
                VALUE .F.
                FONTNAME "Arial"
                FONTSIZE 10
                TOOLTIP ""
                ONCHANGE {|| Filter_msg := form_1.chkBox_3.value, View_Filter()}
                ONGOTFOCUS Nil
                ONLOSTFOCUS Nil
                FONTBOLD .T.
                FONTITALIC .F.
                FONTUNDERLINE .F.
                FONTSTRIKEOUT .F.
                BACKCOLOR Nil
                FONTCOLOR Nil
                HELPID Nil
                TABSTOP .T.
                VISIBLE .T.
                TRANSPARENT .F.
            END CHECKBOX
			
			DEFINE LABEL Label_1
                ROW    100
                COL    014
                WIDTH  120
                HEIGHT 24
                VALUE "Pasta: "
                FONTNAME "Arial"
                FONTSIZE 10
                TOOLTIP ""
                FONTBOLD .T.
                VISIBLE .T.
                TRANSPARENT .F.
                AUTOSIZE .F.
                FONTCOLOR Nil
            END LABEL
            
            DEFINE TEXTBOX txtBox_3
                ROW 100
                COL 056                
				WIDTH 485
                HEIGHT 21
				FONTNAME "MS Sans Serif"
				FONTSIZE 10
				DISABLEDFONTCOLOR {000,000,255}
				DISABLEDBACKCOLOR {255,255,190}
				BACKCOLOR {000,000,255}
                FONTCOLOR {255,255,190}
                READONLY .T.
				VSCROLLBAR .F.
                HSCROLLBAR .F.
            END EDITBOX
			
            @ 098 , 550 BUTTON  boton_open PICTURE 'OPEN_BMP' WIDTH 39 HEIGHT 24 ACTION {|| a:= GetFile(Filtro,"Open "+FileLog,If(Empty(AllTrim(Form_1.txtBox_3.Value)),"",AllTrim(Form_1.txtBox_3.Value)),.F.,.F.),Form_1.txtBox_3.Value := IF(EMPTY(a), Path, Path:=a), IF(EMPTY(a), NIL, Load_Build()) }
            @ 150 , 010 EDITBOX Edit_box_1 WIDTH 580 HEIGHT 250 FONT "Courier" SIZE 10 DISABLEDFONTCOLOR {000,000,255} DISABLEDBACKCOLOR {255,255,190} READONLY 
            @ 405 , 020 LABEL   Label_Noti Value "O conteúdo atual do arquivo de LOG foi modificado"+CRLF+"(Clique no botão ao lado para atualizar)" BOLD FONTCOLOR RED WIDTH 352 HEIGHT 40 RIGHTALIGN
            @ 410 , 422 BUTTON  Boton_2 CAPTION " Recarregar arquivo " BOLD ACTION Load_Build() WIDTH 140 HEIGHT 28
			Form_1.Label_Noti.Enabled := .F.
			Form_1.Boton_2.Enabled := .F.
           
            DEFINE TIMER Timer_1 INTERVAL 1000 ACTION Check_Changue_Build()
            Form_1.Timer_1.Enabled := .F.
       END PAGE
		
	   DEFINE PAGE "Informação"
			DEFINE IMAGE Image_1
				ROW    31
				COL    13
				WIDTH  579
				HEIGHT 414
				PICTURE "INFO"
				HELPID Nil
				VISIBLE .T.
				STRETCH .T.
				ACTION Nil
			END IMAGE
       END PAGE
	   
    END TAB
	AutoSizeColumn( 'Grid_1', 'Form_1', 1 )
	AutoSizeColumn( 'Grid_1', 'Form_1', 2 )
	AutoSizeColumn( 'Grid_1', 'Form_1', 3 )
	AutoSizeColumnHead( 'Grid_1', 'Form_1', 4 )
	
    form_1.txtBox_1.Enabled := .F.
    form_1.txtBox_2.Enabled := .F.
    form_1.txtBox_3.Value   := Path
    
    @ 478, 015 LABEL Label_0a Value "(c) Dr. Claudio Soto, 6 de Maio de 2010, Uruguai" AUTOSIZE FONT "Comic Sans MS" SIZE 12 FONTCOLOR BLUE
    @ 504, 015 LABEL Label_0b Value "Atualizado por Pablo César Arrascaeta, 9 de Nov 2012, Brasil" AUTOSIZE FONT "Comic Sans MS" SIZE 12 FONTCOLOR BLUE
	@ 522, 542 LABEL Label_0c Value " Versão 2.08" AUTOSIZE FONT "Arial" SIZE 9 FONTCOLOR BLUE BOLD

END WINDOW      
CENTER WINDOW Form_1
ACTIVATE WINDOW Form_1
Return Nil

Function Hay_Log(nItem)
Local cExiste:=Form_1.Grid_1.Cell(nItem,4)

If IsControlDefined(Boton_4,Form_1)
   If cExiste="Sim"
      Form_1.Boton_4.Enabled:=.T.
   Else
      Form_1.Boton_4.Enabled:=.F.   
   Endif
Endif
Form_1.Grid_1.SetFocus
Return Nil

Procedure Changue_Build_ini
IF flag_changue = .F.
   a:= CHANGE_BUILD_LOG_INI(Path_work)
   flag_changue = .T.
   mat1 := DIRECTORY(Path)
ENDIF
Return Nil

Procedure Changue_Build_close
  IF flag_changue = .T.
     a:= CHANGE_BUILD_LOG_CLOSE()
     flag_changue = .F.
  ENDIF
Return Nil

Procedure Check_Changue_Build()
IF flag_changue = .T.
   Form_1.Timer_1.Enabled := .F.
   
   a:= CHANGE_BUILD_LOG_CHECK()     
   IF UPPER(a) == UPPER("Change")
      If FILE(Path) == .T.         
         mat2 := DIRECTORY(Path)
         IF (mat1 [1, F_DATE] <> mat2 [1, F_DATE]) .OR. (mat1 [1, F_TIME] <> mat2 [1, F_TIME])           
            Form_1.Label_Noti.Enabled := .T.
			Form_1.Boton_2.Enabled := .T.
            PlayExclamation() 
            mat1 := ACLONE(mat2)
         ENDIF
      Endif        
   ENDIF
   Form_1.Timer_1.Enabled := .T.
ENDIF
Return Nil

Procedure Open_FileLog
Local item_row_grid
 
IF Form_1.Grid_1.ItemCount = 0 .OR. Form_1.Grid_1.Value = 0
   Msginfo("Nenhum item foi selecionado !")
   Return
ENDIF

item_row_grid := Form_1.Grid_1.Item(Form_1.Grid_1.Value)

IF item_row_grid [4] == NO_LOGFILE
   Msginfo("Arquivo "+FileLog +" não encontrado em: "+CHR(13) + item_row_grid [3])
ELSE
   Path := item_row_grid [3] +"\"+ FileLog      
   Form_1.txtBox_3.Value := Path
   LOAD_BUILD()
   Form_1.Tab_1.Value := 2
ENDIF    
Return Nil

Procedure SORT_INFO_SEARCH(n)
Local nTam:=Len(Info_Search), lMenor:=.T.

If n=1
   If DtoS(CtoD(SubStr(Info_Search[1,n],1,10)))+SubStr(Info_Search[1,n],11,10)<DtoS(CtoD(SubStr(Info_Search[2,n],1,10)))+SubStr(Info_Search[2,n],11,10)
      lMenor:=.F.
   Endif
   If lMenor
      Info_Search := ASORT(Info_Search,,, { |x, y| DtoS(CtoD(SubStr(x[n],1,10)))+SubStr(x[n],11,10) < DtoS(CtoD(SubStr(y[n],1,10)))+SubStr(y[n],11,10) })
   Else
      Info_Search := ASORT(Info_Search,,, { |x, y| DtoS(CtoD(SubStr(x[n],1,10)))+SubStr(x[n],11,10) > DtoS(CtoD(SubStr(y[n],1,10)))+SubStr(y[n],11,10) })
   Endif
Else
   If Upper(Info_Search[1,n])<Upper(Info_Search[2,n])
      lMenor:=.F.
   Endif
   If lMenor
      Info_Search := ASORT(Info_Search,,, { |x, y| Upper(x[n]) < Upper(y[n]) })
   Else
      Info_Search := ASORT(Info_Search,,, { |x, y| Upper(x[n]) > Upper(y[n]) })
   Endif
Endif
Form_1.Grid_1.DeleteAllItems
FOR i = 1 TO nTam
    Form_1.Grid_1.AddItem(Info_Search [i])
NEXT
Return

Function GET_LINKS(ext)
Local i, arch_link, arch, largo, aDir, cDir

Info_Search := {}
text := "" 
largo := Len(ext)
arch_link := GET_FOLDER_LINK()+"\*.lnk"

IF FINDFIRSTFILE(arch_link) = .T.
   cDir := GET_FOLDER_LINK()
   arch := GET_FILE_LINK( cDir +"\"+ GET_FIND_NAME(),1)
   IF IsDirectory(arch)
	  cDir:=arch
	  aDir:=Directory(arch+"\*."+ext)
      If Len(aDir)>0
         arch := ASORT(aDir,,, { |x, y| DtoS(x[3])+x[4] > DtoS(y[3])+y[4] })[1][1]
      Endif
   ENDIF
 
   IF UPPER(RIGHT(arch, largo)) = UPPER(ext)
      text := text + arch +CRLF                                           // Path completo + archivo.lnk
      a := Upper(SubStr(arch,1,1))+Lower(SubStr(arch,2,(At(".",arch)-2))) // 1=Retorna Project name
      b := GET_FILE_LINK(GET_FOLDER_LINK() +"\"+ GET_FIND_NAME(),2)       // 2=Retorna Path completo 
	  If Empty(b)
		 b:=cDir
	  Endif
      c := GET_FILE_LINK(GET_FOLDER_LINK() +"\"+ GET_FIND_NAME(),3)      // 3=Retorna nombre archivo
      d := GET_FILE_LINK(GET_FOLDER_LINK() +"\"+ GET_FIND_NAME(),4)      // 4=Retorna Fecha y Hora del ultimo acceso al archivo
                                                                         // 5=Determina si el objeto especificado ha cambiado desde que se guardó por última vez
      IF FILE(b +"\"+ FileLog) = .T.
         f := YES_LOGFILE
		 d := DtoC(FileDate(b +"\"+ FileLog))+"  "+FileTime(b +"\"+ FileLog)
      ELSE
         f := NO_LOGFILE
      ENDIF
                
      Aadd(Info_Search, {d, a, b, f}) 
   ENDIF    
  
   DO WHILE  FINDNEXTFILE() = .T.            
	  cDir := GET_FOLDER_LINK()
      arch := GET_FILE_LINK( cDir +"\"+ GET_FIND_NAME(),1)
	  IF IsDirectory(arch)
	     cDir:=arch
	     aDir:=Directory(arch+"\*."+ext)
		 If Len(aDir)>0
		    arch := ASORT(aDir,,, { |x, y| DtoS(x[3])+x[4] > DtoS(y[3])+y[4] })[1][1]
		 Else
		    Loop
		 Endif
	  ENDIF
        
      IF UPPER(RIGHT(arch, largo)) = UPPER(ext)
         text := text + arch +CRLF
         a := Upper(SubStr(arch,1,1))+Lower(SubStr(arch,2,(At(".",arch)-2)))
         b := GET_FILE_LINK(GET_FOLDER_LINK() +"\"+ GET_FIND_NAME(),2)
		 If Empty(b)
		    b:=cDir
		 Endif
         c := GET_FILE_LINK(GET_FOLDER_LINK() +"\"+ GET_FIND_NAME(),3)
         d := GET_FILE_LINK(GET_FOLDER_LINK() +"\"+ GET_FIND_NAME(),4)
          
         IF FILE(b +"\"+ FileLog) = .T.
            f := YES_LOGFILE
			d := DtoC(FileDate(b +"\"+ FileLog))+"  "+FileTime(b +"\"+ FileLog)
         ELSE
            f := NO_LOGFILE
         ENDIF
            
         Aadd(Info_Search, {d, a, b, f}) 
       ENDIF    
   ENDDO
   FINDCLOSE()
ENDIF
Return Info_Search

Procedure SHOW_LINK(ext)
Local i, arch_link, arch, largo, aDir, cDir

WaitWindow("Aguarde: Este processo pode demorar alguns segundos...", .T. )

If IsWindowDefined(Upper("Form_1"))
   GET_LINKS(ext)
Endif

SORT_INFO_SEARCH(1) // Show and Sort GRID by Date-Time
WaitWindow()
Form_1.Grid_1.Value:=1
Form_1.Grid_1.SetFocus
Return Nil

Procedure View_Filter
Local Text2, Flag_Filter := .F.
       
IF EMPTY(Text_All)
   Return
ENDIF

IF Filter_msg = .T.
   Text2 := ""
   FOR i = 1 TO MLCOUNT(Text_All,254) 
       linea := MEMOLINE(Text_All,254, i)
   
       IF (SUBSTR(linea, 2,2) = ":/" .OR. SUBSTR(linea, 2,2) = ":\") .AND. Flag_Filter = .F.
          Flag_Filter = .T.
       ENDIF
        
       IF Flag_Filter = .T.
           linea := STRTRAN(linea,CHR(13),"")
           linea := STRTRAN(linea,CHR(10),"")                 
           Text2 := Text2 + linea  + CRLF
       ENDIF
   NEXT
   Form_1.Edit_box_1.Value := Text2
ELSE     
   Form_1.Edit_box_1.Value := Text_All
ENDIF
Return Nil

Procedure LOAD_BUILD
Local Text
 
IF FILE(Path)
   Form_1.Timer_1.Enabled := .F.   
   Changue_Build_close()
   Form_1.Label_Noti.Enabled := .F.
   Form_1.Boton_2.Enabled := .F.
   Path_work := SUBSTR(Path,1,LEN(Path)-LEN(FileLog))
   Changue_Build_ini()        
   Form_1.Timer_1.Enabled := .T.
   
   Text := MEMOREAD(Path)
   If IsOem(Text)
      Text:=HB_OEMTOANSI(Text)
   Endif
   Text := STRTRAN(Text,CHR(10),CRLF)       
   Text_All := Text
   
   View_Filter()
ELSE
   IF EMPTY(Path)
      Msginfo("Caminho não foi especificado !")
   ELSE
      Msginfo("Arquivo não encontrado: "+CHR(13)+Path)
   ENDIF   
ENDIF    
Return Nil

FuncTion IsUtf8( cString )
Local i, cIdUtf := Chr( 195 )
Local aUtf  := { 129, 130, 131, 132, 135, 137, 138, 141, 147, 148, ;
                 149, 150, 154, 156, 160, 161, 163, 162, 164, 167, ;
                 169, 170, 173, 179, 180, 181, 182, 186, 188 }

For i = 1 To Len( aUtf )
    If At( cIdUtf + Chr( aUtf[ i ] ), cString ) > 0
       Return .T.
    Endif
Next
Return .F.

Function IsOem( cString )
Local i, aOem  := { 128, 129, 130, 131, 132, 133, 135, 136, 142, 144, ;
                    147, 148, 153, 154, 160, 161, 162, 163, 181, 182, ;
                    198, 229, 210 }

For i = 1 To Len( aOem )
    If At( Chr( aOem[ i ] ), cString ) > 0 .And. !IsUtf8( cString )
       Return .T.
    Endif
Next
Return .F.

Function AutoSizeColumn( cGridName, cFormName, nColumn )
Local nHandle := GetControlHandle ( cGridName, cFormName)

GridSetAutoColumnSize( nHandle, nColumn - 1 )
Return Nil

Function AutoSizeColumnHead( cGridName, cFormName, nColumn )
Local nHandle := GetControlHandle ( cGridName, cFormName)

GridSetAutoColumnHeadSize( nHandle, nColumn - 1 )
Return Nil


*#########################################################################################################################
*   FUNCION EN C        
*#########################################################################################################################

#pragma begindump

#include <windows.h>
#include <commctrl.h>
#include <wingdi.h>
#include <shlobj.h>
#include "hbapi.h"

HB_FUNC(GET_FOLDER_LINK)
{   
    TCHAR pszPath [MAX_PATH];

      #define SHGFP_TYPE_CURRENT  0   // Retrieve the folder's current path.
  //  #define SHGFP_TYPE_DEFAULT  1   // Retrieve the folder's default path.

    if(SUCCEEDED(SHGetFolderPath(NULL, CSIDL_RECENT, NULL, SHGFP_TYPE_CURRENT, pszPath)))
        hb_retc(pszPath);
    else
        hb_retc("ERROR: The folder does not exist");
            
}

WIN32_FIND_DATA FindFileData;
HANDLE hFind;

HB_FUNC(FINDFIRSTFILE)
{   CHAR *ARCHIVO = (CHAR *) hb_parc(1);
 
    hFind = FindFirstFile(ARCHIVO, &FindFileData);
    if (hFind == INVALID_HANDLE_VALUE) 
    {
        hb_retl(FALSE);
        return;
    } 
    else 
   {
        hb_retl(TRUE);
        return;
   }
}    

HB_FUNC(GET_FIND_NAME)
{
   hb_retc(FindFileData.cFileName);
}

HB_FUNC(FINDCLOSE)
{
   FindClose(hFind);
}

HB_FUNC(FINDNEXTFILE)
{
   if (FindNextFile(hFind, &FindFileData) == 0)
       hb_retl(FALSE);
   else
       hb_retl(TRUE);
}   

HB_FUNC(GET_FILE_LINK)
{
    IShellLink *psl;
    HRESULT hres;
    WIN32_FIND_DATA wfd;
    char szGotPath[MAX_PATH];
    IPersistFile *ppf;

    CHAR msg [255];
    CHAR *ARCHIVO;
    int ACCION;
    SYSTEMTIME fecha;
    FILETIME FechaLocal; 
    
    ARCHIVO =  (CHAR *) hb_parc(1);   // Path completo + archivo.lnk
    ACCION  =  (INT)    hb_parni(2);  // 1=Retorna Path completo + nombre archivo
                                       // 2=Retorna Path completo 
                                       // 3=Retorna nombre archivo
                                       // 4=Retorna Fecha y Hora del ultimo acceso al archivo
                                       // 5=Determina si el objeto especificado ha cambiado desde que se guardó por última vez
                              
    hres = CoInitialize(NULL);
    if (!SUCCEEDED(hres))
    {
        hb_retc("ERROR: Could not open the COM library");
        return;   
    }
    
    hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, &IID_IShellLink, (LPVOID *)&psl);
    if (SUCCEEDED(hres))
    {
        hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile,(void *) &ppf);

        if (SUCCEEDED(hres))
        {
            WORD wsz[MAX_PATH];

            MultiByteToWideChar(CP_ACP, 0, ARCHIVO, -1, wsz, MAX_PATH);

            hres = ppf->lpVtbl->Load(ppf, wsz, STGM_READ);
            
            if (SUCCEEDED(hres))
            {  // Si el link no es correcto, abre ventana del sistema para buscar la coneccion correcta 
               // hres = psl->lpVtbl->Resolve(psl, 0, SLR_ANY_MATCH);  

                if (SUCCEEDED(hres))
                {
                    strcpy(szGotPath, ARCHIVO);    
                                       
                   hres = psl->lpVtbl->GetPath(psl, szGotPath, MAX_PATH, (WIN32_FIND_DATA *)&wfd, SLGP_UNCPRIORITY );
                   //hres = psl->lpVtbl->GetPath(psl, szGotPath, MAX_PATH, (WIN32_FIND_DATA *)&wfd, SLGP_RAWPATH );
                   //hres = psl->lpVtbl->GetPath(psl, szGotPath, MAX_PATH, (WIN32_FIND_DATA *)&wfd, SLGP_SHORTPATH );                   
                   
                   if (!SUCCEEDED(hres))
                   {                 
                       hb_retc("ERROR: GetPath failed");
                       return;
                   }   
                   
                   if (ACCION == 1)
                       hb_retc(szGotPath);
                       
                   if (ACCION == 2)
                   {
                       hres = psl->lpVtbl->GetWorkingDirectory(psl, szGotPath, MAX_PATH);
                       hb_retc(szGotPath);
                   }    
                       
                   if (ACCION == 3)
                       hb_retc(wfd.cFileName);
                
                   if (ACCION == 4)                   
                   {   
                                             
                       //FileTimeToLocalFileTime(&wfd.ftCreationTime,   &FechaLocal);
                       //FileTimeToLocalFileTime(&wfd.ftLastWriteTime,  &FechaLocal);
                       FileTimeToLocalFileTime(&wfd.ftLastAccessTime, &FechaLocal);
                                                                     
                       FileTimeToSystemTime(&FechaLocal, &fecha);                       
                       
                       sprintf(msg, "%02u/%02u/%02u  %02u:%02u:%02u", fecha.wDay, fecha.wMonth, fecha.wYear, fecha.wHour, fecha.wMinute, fecha.wSecond);                   
                       hb_retc(msg);                                                                      
                   }
                   
                   if (ACCION == 5)
                   {   
                       //if (wfd.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)  hb_retc("DIR");                
                       //hres = psl->lpVtbl->GetArguments(psl, szGotPath, MAX_PATH);                       
                       //hres = psl->lpVtbl->GetDescription(psl, szGotPath, MAX_PATH);
                       //hb_retc(szGotPath);
                                             
                       if (ppf->lpVtbl->IsDirty(ppf) == S_OK)
                           hb_retc("The object has changed");
                       else    
                           hb_retc("The object not changed");
                   }                                   
                }
            }
            else
               hb_retc("ERROR: IPersistFile Load Error");
               
           ppf->lpVtbl->Release(ppf);
        }
        else
           hb_retc("ERROR: QueryInterface Error");
          
        psl->lpVtbl->Release(psl);
    }
    else
    {   sprintf(msg,"ERROR: CoCreateInstance Error - hres = %08x", (unsigned int) hres);
        hb_retc(msg);
    }
       
   CoUninitialize();    
   return;
}


//****************************************************************************************************

HANDLE dwChangeHandle;

HB_FUNC(CHANGE_BUILD_LOG_INI)
{  
   LPTSTR lpDir;
   
   lpDir = (LPTSTR) hb_parc(1);
   
   dwChangeHandle = FindFirstChangeNotification(lpDir, FALSE, FILE_NOTIFY_CHANGE_LAST_WRITE);
   
   if (dwChangeHandle == INVALID_HANDLE_VALUE)
   {
       hb_retc("ERROR: FindFirstChangeNotification function failed");
       return;
   }
   if (dwChangeHandle == NULL)
   {
       hb_retc("ERROR: Unexpected NULL from FindFirstChangeNotification");
       return;
   } 
   
   hb_retc("OK");
}


HB_FUNC(CHANGE_BUILD_LOG_CHECK)
{  
   DWORD dwWaitStatus = 0;
   
   dwWaitStatus = WaitForSingleObject(dwChangeHandle, 100);
   
   switch(dwWaitStatus)
   {
         case WAIT_OBJECT_0:
             hb_retc("Change");
             if (FindNextChangeNotification(dwChangeHandle) == FALSE)
             {
               hb_retc("ERROR: FindNextChangeNotification function failed");
               return;
             }
             break;
         
         case WAIT_TIMEOUT:         
            hb_retc("No changes in the timeout period");
            break;

         default:
            hb_retc("ERROR: Unhandled dwWaitStatus");
            return;
            break;
   }
}

HB_FUNC(CHANGE_BUILD_LOG_CLOSE)
{
	if (FindCloseChangeNotification(dwChangeHandle) == 0)
		hb_retc("ERROR: FindCloseChangeNotification function failed");
	else
		hb_retc("OK");
}

HB_FUNC ( GRIDSETAUTOCOLUMNSIZE )
{
	HWND hWnd1;
	hWnd1 = (HWND) hb_parnl (1);
	SendMessage((HWND) hWnd1, LVM_SETCOLUMNWIDTH,    (WPARAM)(int) hb_parni( 2 ),(LPARAM) LVSCW_AUTOSIZE );
}

HB_FUNC ( GRIDSETAUTOCOLUMNHEADSIZE )
{
	HWND hWnd1;
	hWnd1 = (HWND) hb_parnl (1);
	SendMessage((HWND) hWnd1, LVM_SETCOLUMNWIDTH,    (WPARAM)(int) hb_parni( 2 ),(LPARAM) LVSCW_AUTOSIZE_USEHEADER );
}

#pragma enddump

eu baixei ele lá do downloads do pctoledo mas nao achei a função q vc falou Func_GetAppInfo q vc falou
Mário
Responder