Delphi Tecnologia

Como detectar a configuração do proxy automaticamente

29 de novembro de 2011 – 23:15

Ao utilizar a API do Windows, podemos recuperar facilmente as informações de configuração do proxy do perfil de qualquer usuário logado em qualquer estação.

Detalhes da API:

WinHttpGetIEProxyConfigForCurrentUser function

BOOL WINAPI WinHttpGetIEProxyConfigForCurrentUser(
  __inout  WINHTTP_CURRENT_USER_IE_PROXY_CONFIG *pProxyConfig
);

Como utilizá-la:

unit ProxyTest;

interface

uses
  Winapi.Windows, Vcl.Dialogs;

type
  PWinHttpCurrentUserIeProxyConfig = ^TWinHttpCurrentUserIeProxyConfig;

  TWinHttpGetIeProxyConfigForCurrentUser = function (pProxyConfig:
    PWinHttpCurrentUserIeProxyConfig): Boolean; stdcall;

  TWinHttpCurrentUserIeProxyConfig = record
    fAutoDetect: Boolean;
    lpszAutoConfigUrl: PWideChar;
    lpszProxy: PWideChar;
    lpszProxyBypass: PWideChar;
  end;

var
  WinHttpGetIeProxyConfigForCurrentUser: TWinHttpGetIeProxyConfigForCurrentUser;

procedure GetProxy;

implementation

procedure GetProxy;
var
  FHandle: THandle;
  FCurrentUser: PWinHttpCurrentUserIeProxyConfig;
begin
  FHandle := LoadLibrary('winhttp.dll');
  try
    if FHandle <> 0 then
    begin
      @WinHttpGetIeProxyConfigForCurrentUser := GetProcAddress(FHandle,
        'WinHttpGetIEProxyConfigForCurrentUser');

      if Assigned(WinHttpGetIeProxyConfigForCurrentUser) then
      begin
        WinHttpGetIeProxyConfigForCurrentUser(FCurrentUser);
        ShowMessage('Proxy: ' + FCurrentUser.lpszProxy);
      end;
    end;
  finally
    FreeLibrary(FHandle);
  end;
end;

end.

Desenvolvi o exemplo em Delphi XE2, qualquer dúvida é só entrar em contato. :wink:

Tags , , , | Permalink | Comment (0)
Delphi Tecnologia

Obtendo o IP de um cliente Terminal Service

16 de novembro de 2011 – 20:26

Esta publicação é um complemento ao post anterior, Executando aplicações dentro de um Terminal Service. O objetivo desse post é mostrar como podemos obter o IP de uma máquina conectada e executando uma aplicação dentro de um Terminal Service.

A função desenvolvida utiliza a JEDI Windows API, que você pode obter aqui.

unit WTSControl;

interface

uses
  Classes,
  JwaWinsock2,
  JwaWinType,
  JwaWtsApi32,
  SysUtils;

type
  TWTSSession = record
    ClientIP: string;
    Session: Integer;
  end;

  TWTSSessionArray = array of TWTSSession;
  PWtsSessionInfoAArray = ^TWtsSessionInfoAArray;
  TWtsSessionInfoAArray = array [0 .. ANYSIZE_ARRAY - 1] of WTS_SESSION_INFOA;

function GetClientIP(const Server: string): TWTSSessionArray;

implementation

function GetClientIP(const Server: string): TWTSSessionArray;
var
  ASession: PWtsSessionInfoAArray;
  FBytes: Cardinal;
  FClientAdd: PWtsClientAddress;
  FHandle: THandle;
  FIP: string;
  I: Cardinal;
  X: Integer;
begin
  if Trim(Server) = '' then
    FHandle := WTS_CURRENT_SERVER
  else
    FHandle := WTSOpenServer(PChar(Server));

  if WTSEnumerateSessions(FHandle, 0, 1, PWTS_SESSION_INFO(ASession), I) then
  begin
    SetLength(Result, I);

    for X := 0 to I - 1 do
    begin
      WTSQuerySessionInformation(FHandle, ASession^[X].SessionId,
        WTSClientAddress, Pointer(FClientAdd), FBytes);

      case FClientAdd^.AddressFamily of
        AF_INET:
          begin
            FIP := Format('%d.%d.%d.%d', [FClientAdd^.Address[2],
              FClientAdd^.Address[3], FClientAdd^.Address[4],
              FClientAdd^.Address[5]]);
          end;
        AF_INET6:
          begin
            FIP := 'IPv6 address not yet supported';
          end;
        AF_IPX:
          begin
            FIP := 'IPX is not supported';
          end;
        AF_NETBIOS:
          begin
            FIP := 'NETBIOS is not supported';
          end;
        AF_UNSPEC:
          begin
            FIP := 'Console and listener session have no address';
          end;
      end;
      Result[X].ClientIP := FIP;
      Result[X].Session := ASession^[X].SessionId;
      WTSFreeMemory(FClientAdd);
    end;
  end;
end;

end.

Criei o record TWTSSession para retornar um array, definido como TWTSSessionArray, de todas as sessões existentes no servidor Terminal Service. Segue abaixo um exemplo de utilização:

procedure Executar;
var
  AWTS: TWTSSessionArray;
  FCount: Integer;
begin
  AWTS := GetClientIP('');
  for FCount := Low(AWTS) to High(AWTS) do
  begin
    ShowMessage('Session: ' + FormatFloat('00000', AWTS[FCount].Session) +
      ' IP: ' + AWTS[FCount].ClientIP);
  end;
end;

O download do código-fonte pode ser feito aqui.

Tags , , | Permalink | Comment (0)
Delphi Tecnologia

Executando um processo com segurança no Windows

30 de outubro de 2011 – 11:33

Imagine a seguinte situação: sua empresa solicita um importante processo, que, por apresentar alto custo de execução, deve ser executado a noite ou iniciado no final da tarde e o tempo de execução seja de aproximadamente 8 horas (por exemplo).

Você inicia esse processo, mas, no meio da execução, ele é interrompido. Seu Windows entrou em hibernação após um determinado tempo. Infelizmente todo o seu trabalho acabou atrasando um dia, pois terá que ser executado no dia seguinte.

Esse é um exemplo banal mas que acontece muito no cotidiano dos profissionais de TI. Para não dependermos de configurações externas, podemos utilizar a própria API do Windows, utilizando a função SetThreadExecutionState e tornando o nosso software mais inteligente e evitando assim surpresas desagradáveis!  :lol:

Vejam a classe desenvolvida abaixo. Através dela, conseguimos proteger qualquer rotina que seja critica enquanto estiver em execução.

unit CriticalProcess;

interface

type
  TCriticalProcess = class
  protected
    procedure Execute(const Value: Boolean); virtual;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Stop;
    procedure Start;
  end;

var
  CriticalProcess: TCriticalProcess;

implementation

uses
  Windows;

type
  EXECUTION_STATE = DWORD;

const
  ES_CONTINUOUS      = $80000000;
  ES_SYSTEM_REQUIRED = $00000001;

procedure SetThreadExecutionState(ESFlags: EXECUTION_STATE); stdcall;
  external kernel32 name 'SetThreadExecutionState';

constructor TCriticalProcess.Create;
begin
  inherited;

end;

destructor TCriticalProcess.Destroy;
begin

  inherited;
end;

procedure TCriticalProcess.Stop;
begin
  Execute(False);
end;

procedure TCriticalProcess.Start;
begin
  Execute(True);
end;

procedure TCriticalProcess.Execute(const Value: Boolean);
begin
  if Value then
    SetThreadExecutionState(ES_SYSTEM_REQUIRED or ES_CONTINUOUS)
  else
    SetThreadExecutionState(ES_CONTINUOUS);
end;

initialization
  CriticalProcess := TCriticalProcess.Create;

finalization
  CriticalProcess.Free;

end.

Exemplo de utilização da classe:

uses
  CriticalProcess;

procedure TfrmExemplo.btnExecutarClick(Sender: TObject);
begin
  CriticalProcess.Start;
  try
    // Coloque aqui todo o processamento crítico.

    // Todo o bloco de código inserido aqui estará protegido
    // e será executado sem interferências do sistema operacional.

  finally
    CriticalProcess.Stop;
  end;
end;

Toda a documentação sobre o método SetThreadExecutionState é encontrado no site da Microsoft.

Tags , | Permalink | Comment (0)

Próxima Página »

Próxima Página »