unit main;
{$mode objfpc}{$H+}
interface
uses
windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, Menus, jwatlhelp32, shlobj, mi_about, registry, JwaIpHlpApi, JwaIpTypes,
synaip, httpsend, synautil;
const
nString = 'SOFTWARE\MICROSOFT\WINDOWS NT\CURRENTVERSION\NetworkCards';
//nString = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards\';
nEthernet = 'Ethernet';
nEtherjet = 'Etherjet'; {if Hardware IBM PL300 with Chip 10/100}
{nTcpIp1 = 'SYSTEM\CurrentControlSet\Services\';
nTcpIp2 = '\Parameters\Tcpip';}
nTcpIp1 = 'SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\';
//nTcpIp2 = '\Parameters\Tcpip';
type
{ TForm_ips }
TForm_ips = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Button1: TButton;
Memo1: TMemo;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
PopupMenu1: TPopupMenu;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MenuItem1Click(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
procedure MenuItem3Click(Sender: TObject);
private
{ private declarations }
public
procedure getall_nets;
function get_adapters_info: TStrings;
{ public declarations }
end;
var
Form_ips: TForm_ips;
mydestino: string;
reg: TRegistry;
buffer1, buffer2, buffer3: array [1..32] of Char;
i, dhcp_valor: Integer;
ipaddress, subnetmask, DefaultGateway, dns: string;
Adapter, Adapter_Key: string;
datos1, datos2, datos3, datos4: string;
stringlist: TStrings;
astring, description, st: string;
//listaRED: TStringList;
my_puerta_enlace, my_ip, my_mask, my_dns: TStringList;
Buffer33: PChar;
BufSize: Integer; {Bufsize requested but not used
Bufsize erforderlich aber nicht benutzt}
Lista: TstringList;
implementation
{$R *.lfm}
{ TForm_ips }
procedure my_ip_externo;
var
HTTPGetResult: boolean;
HTTPSender: THTTPSend;
URL:String;
Content : TStringList;
s:String;
begin
//result:='';
URL:='http://checkip.dyndns.org';
HTTPSender:=THTTPSend.Create;
Content :=TStringList.Create;
try
HTTPGetResult:=HTTPSender.HTTPMethod('GET', URL);
if HTTPSender.Resultcode=200 then
begin
Content.LoadFromStream(HTTPSender.Document);
if Content.Count>0 then
begin
s:=Content.Strings[0];
synautil.Fetch(s,'Current IP Address:');
s:=synautil.Fetch(s,'<');
s:=trim(s);
if IsIp(s) then
//result:=s;
begin
//Form_ips.Memo1.Clear;
Form_ips.Memo1.Lines.Add('DIRECCION IP EXTERNA :');
Form_ips.Memo1.Lines.Add('-------------------------');
Form_ips.Memo1.Lines.add(s);
Form_ips.Memo1.Lines.Add('');
end;
end;
end;
finally
Content.Free;
HTTPSender.Free;
end;
end;
function tform_ips.get_adapters_info: TStrings;
const
WIRELESS_ADAPTER = 71;
ETHERNET_ADAPTER = 6;
var
NumInterfaces: Cardinal;
AdapterInfo: array of TIpAdapterInfo;
OutBufLen: ULONG;
i: integer;
mac, Tipo : string;
AdaptersInfo : TStrings;
begin
GetNumberOfInterfaces(NumInterfaces);
SetLength(AdapterInfo, NumInterfaces);
OutBufLen := NumInterfaces * SizeOf(TIpAdapterInfo);
GetAdaptersInfo(@AdapterInfo[0], OutBufLen);
AdaptersInfo := TStringList.Create;
for i := 0 to NumInterfaces - 1 do begin
mac := Format('%.2x:%.2x:%.2x:%.2x:%.2x:%.2x',
[AdapterInfo[i].Address[0], AdapterInfo[i].Address[1],
AdapterInfo[i].Address[2], AdapterInfo[i].Address[3],
AdapterInfo[i].Address[4], AdapterInfo[i].Address[5]]);
case AdapterInfo[i].Type_ of
WIRELESS_ADAPTER : Tipo := 'WIF';
ETHERNET_ADAPTER : Tipo := 'ETH';
end;
if AdapterInfo[i].Description <> EmptyStr then
AdaptersInfo.Add(IntToStr(i)
+ ' - ' + Tipo
+ ' - ' + AdapterInfo[i].Description
+ ' - ' + mac);
end;
Result := AdaptersInfo;
end;
procedure ReadREG_MULTI_SZ(const CurrentKey: HKey; const Subkey, ValueName: string;
Strings: TStrings);
var
valueType: DWORD;
valueLen: DWORD;
p, buffer: PChar;
key: HKEY;
begin
// Clear TStrings
// TStrings leeren
Strings.Clear;
// open the specified key
// CurrentKey Schlüssel öffnen
if RegOpenKeyEx(CurrentKey,
PChar(Subkey),
0, KEY_READ, key) = ERROR_SUCCESS then
begin
// retrieve the type and data for a specified value name
// Den Typ und Wert des Eintrags Ermitteln.
SetLastError(RegQueryValueEx(key,
PChar(ValueName),
nil,
@valueType,
nil,
@valueLen));
if GetLastError = ERROR_SUCCESS then
if valueType = REG_MULTI_SZ then
begin
GetMem(buffer, valueLen);
try
// receive the value's data (in an array).
// Ein Array von Null-terminierten Strings
// wird zurückgegeben
RegQueryValueEx(key,
PChar(ValueName),
nil,
nil,
PBYTE(buffer),
@valueLen);
// Add values to stringlist
// Werte in String Liste einfügen
p := buffer;
while p^ <> #0 do
begin
Strings.Add(p);
Inc(p, lstrlen(p) + 1)
end
finally
FreeMem(buffer)
end
end
else
raise ERegistryException.Create('Stringlist expected/ String Liste erwartet...')
else
my_puerta_enlace.Add('No Encontrado');
{raise ERegistryException.Create('Cannot Read MULTI_SZ Value/'+
'Kann den MULTI_SZ Wert nicht lesen...');}
end;
end;
procedure tform_ips.getall_nets;
var
nPos: integer;
ServiceName: string;
begin
//listaRED := TStringList.Create;
form_ips.Memo1.Clear;
reg := TRegistry.Create;
stringlist := TStringList.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKeyReadOnly(nString);
reg.GetKeyNames(stringlist); {search all subkeys
such alle unterschlüssel}
reg.CloseKey;
Memo1.Lines.Add('ADAPTADORES DE RED :');
Memo1.Lines.Add('-------------------------');
for i := 0 to (stringlist.Count - 1) do
begin
st := stringlist[i];
aString := nString + '\' + st;
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKeyReadOnly(aString);
description := reg.ReadString('Description');
//listaRED.Add(description);
//ShowMessage(description); // ok
begin
ServiceName := reg.ReadString('ServiceName');
//Adapter_Key := nTcpIp1 + ServiceName + nTcpIp2; // original
Adapter_Key := nTcpIp1 + ServiceName;
end;
adapter := Adapter_Key; // SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\{A20B42C2-2312-4B24-9845-EEEDC1EE5F5C}
if adapter <> '' then
begin
Reg := TRegistry.Create;
//try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKeyReadOnly(adapter);
//Reg.ReadBinaryData('dhcpIpAddress', buffer1, BufSize);
//datos1:=reg.ReadString('dhcpIpAddress');
dhcp_valor:=reg.ReadInteger('EnableDHCP');
//ShowMessage(inttostr(dhcp_valor));
//description := reg.ReadString('Description');
//finally
Reg.CloseKey;
Reg.Free;
//end;
if dhcp_valor <> 0 then // acá determinar si la ip es fija (puesta por el usuario o es dinámica)
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKeyReadOnly(adapter);
//Reg.ReadBinaryData('dhcpIpAddress', buffer1, BufSize);
if reg.ValueExists('dhcpIpAddress') then datos1:=reg.ReadString('dhcpIpAddress')
else datos1:='No Encontrado';
//description := reg.ReadString('Description');
finally
Reg.CloseKey;
Reg.Free;
end;
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKeyReadOnly(adapter);
//Reg.ReadBinaryData('dhcpSubnetMask', buffer2, BufSize);
if reg.ValueExists('dhcpSubnetMask') then datos2:=reg.ReadString('dhcpSubnetMask')
else datos2:='No Encontrado';
finally
Reg.CloseKey;
Reg.Free;
end;
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKeyReadOnly(adapter);
//Reg.ReadBinaryData('dhcpSubnetMask', buffer2, BufSize);
if reg.ValueExists('DhcpNameServer') then datos3:=reg.ReadString('DhcpNameServer')
else datos3:='No Encontrado';
finally
Reg.CloseKey;
Reg.Free;
end;
begin
my_puerta_enlace := TStringList.Create;
ReadREG_MULTI_SZ(HKEY_LOCAL_MACHINE, adapter, 'DhcpDefaultGateway', my_puerta_enlace); // puerta enlace // AQUI PIENSO QUE PODEMOS PONER EN VEZ DE Memo1.Lines PONER UNA VARIABLE STRING LUEGO ESA VARIABLE PONERLO EN TAL LUGAR
form_ips.Memo1.Lines.Add('Adaptador de RED : '+description);
form_ips.Memo1.Lines.Add('Dirección IP : '+datos1); // IP
form_ips.Memo1.Lines.Add('Máscara de RED : '+datos2); // mascara
form_ips.Memo1.Lines.Add('Puerta de enlace : '+my_puerta_enlace[0]); // puerta enlace
form_ips.Memo1.Lines.Add('DNS : '+datos3); // dns
form_ips.Memo1.Lines.Add('');
end;
end
else
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKeyReadOnly(adapter);
//Reg.ReadBinaryData('dhcpIpAddress', buffer1, BufSize);
datos3:=reg.ReadString('NameServer');
//description := reg.ReadString('Description');
finally
Reg.CloseKey;
Reg.Free;
end;
my_ip:= TStringList.Create;
my_mask:= TStringList.Create;
my_puerta_enlace := TStringList.Create;
ReadREG_MULTI_SZ(HKEY_LOCAL_MACHINE, adapter, 'IpAddress', my_ip);
ReadREG_MULTI_SZ(HKEY_LOCAL_MACHINE, adapter, 'SubnetMask', my_mask);
ReadREG_MULTI_SZ(HKEY_LOCAL_MACHINE, adapter, 'DefaultGateway', my_puerta_enlace);
form_ips.Memo1.Lines.Add('Adaptador de RED : '+description);
form_ips.Memo1.Lines.Add('Dirección IP : '+my_ip[0]); // IP
form_ips.Memo1.Lines.Add('Máscara de RED : '+my_mask[0]); // mascara
//form_ips.Memo1.Lines.Add('Puerta de enlace : '+my_puerta_enlace.Text); // puerta enlace ORIGINAL
form_ips.Memo1.Lines.Add('Puerta de enlace : '+my_puerta_enlace[0]); // puerta enlace
form_ips.Memo1.Lines.Add('DNS : '+datos3); // dns
form_ips.Memo1.Lines.Add('');
end;
end;
end;
end;
function LeerUsuarioWindows: string;
var
sNombreUsuario: String;
dwLongitudNombre: DWord;
begin
dwLongitudNombre := 255;
SetLength( sNombreUsuario, dwLongitudNombre );
if GetUserName( PChar( sNombreUsuario ), dwLongitudNombre ) Then
Result := Copy( sNombreUsuario, 1, dwLongitudNombre - 1 )
else
Result := 'Desconocido';
End;
procedure TForm_ips.Button1Click(Sender: TObject);
begin
BeginThread(TThreadFunc(@my_ip_externo));
end;
procedure TForm_ips.BitBtn1Click(Sender: TObject);
begin
Memo1.clear;
getall_nets;
begin
Memo1.Lines.Add('DIRECCIONES MAC :');
Memo1.Lines.Add('----------------------');
Memo1.Lines.Add(get_adapters_info.Text);
end;
//begin
BeginThread(TThreadFunc(@my_ip_externo));
//end;
end;
procedure TForm_ips.BitBtn2Click(Sender: TObject);
begin
with BitBtn2.ClientToScreen(point(0, BitBtn2.Height)) do
PopupMenu1.Popup(X, Y);
{with SpeedButton9.ClientToScreen(point(0, SpeedButton9.Height)) do
PopupMenu6.Popup(X, Y);}
end;
procedure TForm_ips.BitBtn3Click(Sender: TObject);
begin
Form1_about:= tForm1_about.Create(self);
Form1_about.ShowModal;
end;
procedure TForm_ips.FormCreate(Sender: TObject);
begin
//obtener_passwifi;
getall_nets;
begin
Memo1.Lines.Add('DIRECCIONES MAC :');
Memo1.Lines.Add('----------------------');
Memo1.Lines.Add(get_adapters_info.Text);
end;
//begin
BeginThread(TThreadFunc(@my_ip_externo));
//end;
end;
procedure TForm_ips.MenuItem1Click(Sender: TObject);
var
I: Integer;
//SD: TSaveDialog;
SL: TStringList;
AppDataPath: Array[0..MaxPathLen] of Char; //Allocate memory
begin
AppDataPath:='';
SHGetSpecialFolderPath(0,AppDataPath,CSIDL_DESKTOPDIRECTORY,false); // obetenemos el path del escritorio
//Memo1.Lines.Add(AppDataPath); // ejem: C:\users\ericksystem\desktop
Memo1.Lines.SaveToFile(AppDataPath+'\'+LeerUsuarioWindows+'_REPORTE IP y RED.txt');
end;
procedure TForm_ips.MenuItem2Click(Sender: TObject);
var
I: Integer;
SL: TStringList;
begin
Memo1.Lines.SaveToFile(ExtractFilePath(Application.ExeName)+LeerUsuarioWindows+'_REPORTE IP y RED.txt');
end;
procedure TForm_ips.MenuItem3Click(Sender: TObject);
var
I: Integer;
SD: TSaveDialog;
{SL: TStringList;}
begin
SD := TSaveDialog.Create(self);
try
with SD do
begin
Title := 'Respaldo de Archivo en Formato TXT';
FileName:=LeerUsuarioWindows+'_REPORTE IP y RED.txt';
InitialDir := GetCurrentDir;
Filter := 'Texto (delimitado por tabulaciones) (*.txt)|*.txt';
DefaultExt := 'txt';
FilterIndex := 1;
if Execute then
begin
Memo1.Lines.SaveToFile(SD.FileName);
end;
end;
finally
SD.Free;
end;
end;
end.
Recent
