GARANTIR DESCONTO

Fórum Funçao Para achar o IP da maquina #231033

09/05/2004

0

Gostaria fazer uma funçao que localiza o ip da maquina para ativar o cliente ou server...
Estou sem raciocinio.... :oops:

Muito grato


Gollum

Gollum

Responder

Posts

10/05/2004

Celo-faveri

eaí kra, beleza?

tu pode usar essa função:

[color=darkblue:cf12cd92e6]
Function GetIP:string;
//--> Declare a Winsock na clausula uses da unit
var
WSAData: TWSAData;
HostEnt: PHostEnt;
Name:string;
begin
WSAStartup(2, WSAData);
SetLength(Name, 255);
Gethostname(PChar(Name), 255);
SetLength(Name, StrLen(PChar(Name)));
HostEnt := gethostbyname(PChar(Name));
with HostEnt^ do
begin
Result := Format(´¬d.¬d.¬d.¬d´,
[Byte(h_addr^[0]),Byte(h_addr^[1]),
Byte(h_addr^[2]),Byte(h_addr^[3])]);
end;
WSACleanup;
end;
[/color:cf12cd92e6]

T+ :wink:


Responder

Gostei + 0

10/05/2004

Otto

caso sua máq tenha duas ou mais placas de redes, tente o seguinte:

const
  ANY_SIZE      = 1;


depois...

type
  PTMibIPAddrRow = ^TMibIPAddrRow;
  TMibIPAddrRow = packed record
    dwAddr: DWORD;
    dwIndex: DWORD;
    dwMask: DWORD;
    dwBCastAddr: DWORD;
    dwReasmSize: DWORD;
    Unused1,
      Unused2: WORD;
  end;
  PTMibIPAddrTable = ^TMibIPAddrTable;
  TMibIPAddrTable = packed record
    dwNumEntries: DWORD;
    Table: array[0..ANY_SIZE - 1] of TMibIPAddrRow;
  end;



depois....


function GetIpAddrTable( pIpAddrTable: PTMibIPAddrTable;
  pdwSize: PULONG;
  bOrder: BOOL ): DWORD;
stdcall; external ´IPHLPAPI.DLL´;

{ converts IP-address in network byte order DWORD to dotted decimal string}
function IpAddr2Str( IPAddr: DWORD ): string;
var
  i : integer;
begin
  Result := ´´;
  for i := 1 to 4 do
  begin
    Result := Result + Format( ´¬3d.´, [IPAddr and $FF] );
    IPAddr := IPAddr shr 8;
  end;
  Delete( Result, Length( Result ), 1 );
end;

procedure Get_IPAddrTable(Tipo: Integer; List: TStrings );
var
  IPAddrRow     : TMibIPAddrRow;
  TableSize     : DWORD;
  ErrorCode     : DWORD;
  i             : integer;
  pBuf          : PChar;
  NumEntries    : DWORD;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;
  TableSize := 0; ;
  // first call: get table length
  ErrorCode := GetIpAddrTable( PTMibIPAddrTable( pBuf ), @TableSize, true );
  if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
    EXIT;

  GetMem( pBuf, TableSize );
  // get table
  ErrorCode := GetIpAddrTable( PTMibIPAddrTable( pBuf ), @TableSize, true );
  if ErrorCode = NO_ERROR then
  begin
    NumEntries := PTMibIPAddrTable( pBuf )^.dwNumEntries;
    if NumEntries > 0 then
    begin
      inc( pBuf, SizeOf( DWORD ) );
      for i := 1 to NumEntries do
      begin
        Case Tipo of
        1 : begin
             IPAddrRow := PTMIBIPAddrRow( pBuf )^;
             with IPAddrRow do
               List.Add( Format( ´¬8.8x|¬15s|¬15s|¬15s|¬8.8d´,
                 [dwIndex, IPAddr2Str( dwAddr ), IPAddr2Str( dwMask ),
                   IPAddr2Str( dwBCastAddr ), dwReasmSize ] ) );
             inc( pBuf, SizeOf( TMIBIPAddrRow ) );
            end;
        2 : begin
             IPAddrRow := PTMIBIPAddrRow( pBuf )^;
             List.Add( Format(´¬15s´,[IPAddr2Str(IPAddrRow.dwAddr)]) );
             inc( pBuf, SizeOf( TMIBIPAddrRow ) );
            end;
        //3 : //;
        end;
      end;
    end
    else
      List.Add( ´no entries.´ );
  end
  else
    List.Add( SysErrorMessage( ErrorCode ) );

  // we must restore pointer!
  dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPAddrRow ) );
  FreeMem( pBuf );
end;



---------
insira no form um memo e um combobox...

e no evento onclick de um botão faça o seguinte:

Get_IPAddrTable(1, Memo1.Lines);
Get_IPAddrTable(2, ComboBox1.Items);




valeu??


abraço...


Responder

Gostei + 0

10/05/2004

Gollum

Obrigado a todos que postaram...
foi de grande ajuda....


Responder

Gostei + 0

28/01/2010

Maurothiagobr

Olá colegas,
sou novo por aqui e nos desenvolvimentos em Delphi. Estou estudando sobre a IPHLPAPI.DLL e estava tentando usar os codes postados pelo nosso colega ´oTTo´ e no Windows 7 com Delphi 2009 não foi. Somente com Delphi 7 funcionou perfeitamente.

O que pode ser para não funcionar legal no Delphi 2009, sendo que usei inclusive o mesmo projeto.
Agradeço a todos pela ajuda e parabéns ´oTTo´ pelo post.

É perfeito!
Thiago


Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar