Problem "unfreed memory blocks"

[sstvmaster]

Hallo,

Ich habe mir ein kleines Testprogramm mit "iphlpapi" geschrieben.
Ich hatte es mir so vorgestellt das ich diese Unit nur einbinden brauch und mein "array of record" (TAdapterInfosA)
deklariere im meinem Form1.

Das funktioniert soweit auch, nach klick auf dem Button werden die Daten im Memo angezeigt.
Wenn ich das Programm schließe bekomme ich eine "unfreed memory blocks" Meldung.

Was mache ich falsch, wie macht man das richtig?

ACHTUNG, es wird synapse benötigt und läuft nur unter Windows!

LG Maik

[Warf]

Schnelle antwort:

Code: Alles auswählen

while (pAdapterInfo <> nil) do    

Bedeutet das der Loop erst aufhört wenn pAdapterInfo nil ist. Wenn dem der Fall ist macht bringt Dispose(pAdapterInfo); aber natürlich nix. D.h. dein speicher wird nicht aufgeräumt.
Lösung:

Code: Alles auswählen

 
  pAdapterInfo := AllocMem(BufLen);
  origPtr := pAdapterInfo; 
...
  finally
    Dispose(origPtr);

ABER: du benutzt die winAPI funktion GetAdaptersInfo. Also schau ich auf MSDN nach und das erste was auf der Seite steht ist:

On Windows XP and later: Use the
GetAdaptersAddresses function instead of GetAdaptersInfo.

Jetzt gibt es zwei möglichkeiten, entweder du entwickelst die Software für Windows 2000, falls ja kann man dir nicht mehr helfen, oder du hast ein neueres System, dann solltest du mal ganz schnell das ganze richtig machen

Ansonsten noch ein paar nitpicks für saubereren/besseren Code:

Code: Alles auswählen

IP_ADDRESS_STRING = packed record
    ToString: array [1..16] of Char;
  end;      

Mach doch einfach

Code: Alles auswählen

IP_ADDRESS_STRING = array [1..16] of Char;

Der Packed Record hilft hier keinem

Code: Alles auswählen

TAdapterInfosA = array of TAdaptersInfo;

Da war wohl einer zu faul bei TAdapterInfosA das Array am ende auszuschreiben Ich war am anfang verwirrt, denn normalerweise bedeutet bei WinAPI kram ein A am Ende das es Ascii ist (und W für WideChars). Schreib das Array doch einfach aus. Lazarus hat ne Autocompletion du tippst dich also nicht tod

Code: Alles auswählen

  try
    // IP Infos
    Status := GetAdaptersInfo(pAdapterInfo, @BufLen);
    if (Status <> ERROR_SUCCESS) then
    begin
      Dispose(pAdapterInfo);
      Exit;
    end;
...
  finally
    Dispose(pAdapterInfo);
  end; 

Finally sorgt dafür das das Dispose auf jeden fall ausgeführt wird, da brauchst du es vor dem Exit nicht nochmal (sonst wär try-finally ja nutzlos)

Code: Alles auswählen

    while (pAdapterInfo <> nil) do
    begin
      SetLength(Result, IndexA + 1);  

Am anfang ein:

Code: Alles auswählen

    SetLength(Result, BufLen div sizeOf(IP_ADAPTER_INFO));  

tuts auch

Code: Alles auswählen

          strMAC := strMAC + '-' + IntToHex(pAdapterInfo^.Address[i], 2);  
      end;
      Delete(strMAC, 1, 1);  

Am ende zu löschen ist effizienter als am anfang, daher willst du wahrscheinlich eher sowas machen:

Code: Alles auswählen

          strMAC := strMAC + IntToHex(pAdapterInfo^.Address[i], 2) + ' - ';  
      end;
      SetLength(StrMac, StrMac.Length-3);  

Außerdem, auch wenn man jetzt darüber streiten kann ob es sich lohnt, aber ich finds schöner, könntest du das so umschreiben zu

Code: Alles auswählen

strMAC := '%s - %2x'.Format([strMAC, pAdapterInfo^.Address[i]]);  

Außerdem, wenn ich in die Definition von IP_ADAPTER_INFO.Address schaue sehe ich da array [1..MAX_ADAPTER_ADDRESS_LENGTH] of Byte;
Wie wärs also das du statt mit {$RANGECHECKS OFF} die Fehlererkennung einfach ausschaltest, stattdessen den Fehler fixt der zu der Meldung kommt:

Code: Alles auswählen

for i := 1 to pAdapterInfo^.AddressLength do

[sstvmaster]

Hi Warf,

vielen Dank für deine Ausführungen.
Ich habe das Beispiel hier oder im englischen Forum gefunden und habe damit experimentiert.

Jetzt gibt es zwei möglichkeiten, entweder du entwickelst die Software für Windows 2000...

Nein natürlich nicht. Ich kannte die Funktion "GetAdaptersAddresses" nicht.

Ich habe mir nun die Funktion "GetAdaptersAddresses" näher angeschaut, leider gibt es für Lazarus nur wenig Beispiele.
Außerdem scheint es als wäre GetAdaptersAddresses nicht implementiert zu sein so wie es in Delphi ist.
Oder ich finde es nicht.

LG Maik

[Warf]

Ich habe mir nun die Funktion "GetAdaptersAddresses" näher angeschaut, leider gibt es für Lazarus nur wenig Beispiele.
Außerdem scheint es als wäre GetAdaptersAddresses nicht implementiert zu sein so wie es in Delphi ist.
Oder ich finde es nicht.

LG Maik

Auf der msdn seite gibts ein C Beispiel, und C lässt sich eigentlich durch reine Syntaxumformungen zu pascal umschreiben.
Ich hab dir mal den Typen übersetzt:

Code: Alles auswählen

uses  Windows,
  sockets;
 
{$PackRecords C}
// see https://docs.microsoft.com/en-us/window ... et_address
type
  TSOCKET_ADDRESS = record
    SockAddr: psockaddr;
    SockAddrLength: integer;
  end;
 
  // For primitive types: https://github.com/tpn/winsdk-10/blob/m ... ed/ifdef.h
 
  // see https://docs.microsoft.com/en-us/window ... address_lh
type
  PIP_ADAPTER_UNICAST_ADDRESS_LH = ^TIP_ADAPTER_UNICAST_ADDRESS_LH;
 
  TIP_ADAPTER_UNICAST_ADDRESS_LH = record
    Alignment: record
      case boolean of
        True: (Alignment: ULONGLONG);
        False: (Length: ULONG;
          FLAGS: DWORD);
    end;
    Next: PIP_ADAPTER_UNICAST_ADDRESS_LH;
    Address: TSOCKET_ADDRESS;
    PrefixOrigin: integer;
    SuffixOrigin: integer;
    DadState: integer;
    ValidLifetime: ULONG;
    PreferredLifetime: ULONG;
    LeaseLifetime: ULONG;
    OnLinkPrefixLength: ULONG;
  end;
 
  // see https://github.com/tpn/winsdk-10/blob/m ... /IPTypes.h
type
  PIP_ADAPTER_ANYCAST_ADDRESS_XP = ^TIP_ADAPTER_ANYCAST_ADDRESS_XP;
 
  TIP_ADAPTER_ANYCAST_ADDRESS_XP = record
    Alignment: record
      case boolean of
        True: (Alignment: ULONGLONG);
        False: (Length: ULONG;
          FLAGS: DWORD);
    end;
    Next: PIP_ADAPTER_ANYCAST_ADDRESS_XP;
    Address: TSOCKET_ADDRESS;
  end;
 
  PIP_ADAPTER_MULTICAST_ADDRESS_XP = PIP_ADAPTER_ANYCAST_ADDRESS_XP;
  TIP_ADAPTER_MULTICAST_ADDRESS_XP = TIP_ADAPTER_ANYCAST_ADDRESS_XP;
 
  // eigentlich müsste Alignment.Flags durch Alignment.Reserved getauscht werden, ich bin aber faul
  PIP_ADAPTER_DNS_SERVER_ADDRESS_XP = PIP_ADAPTER_ANYCAST_ADDRESS_XP;
  TIP_ADAPTER_DNS_SERVER_ADDRESS_XP = TIP_ADAPTER_ANYCAST_ADDRESS_XP;
 
  PIP_ADAPTER_WINS_SERVER_ADDRESS_LH = PIP_ADAPTER_ANYCAST_ADDRESS_XP;
  TIP_ADAPTER_WINS_SERVER_ADDRESS_LH = TIP_ADAPTER_ANYCAST_ADDRESS_XP;
 
  PIP_ADAPTER_GATEWAY_ADDRESS_LH = PIP_ADAPTER_ANYCAST_ADDRESS_XP;
  TIP_ADAPTER_GATEWAY_ADDRESS_LH = TIP_ADAPTER_ANYCAST_ADDRESS_XP;
 
 
const
  MAX_DNS_SUFFIX_STRING_LENGTH = 256;
type
  PIP_ADAPTER_DNS_SUFFIX = ^TIP_ADAPTER_DNS_SUFFIX;
 
  TIP_ADAPTER_DNS_SUFFIX = record
    Next: PIP_ADAPTER_DNS_SUFFIX;
    Str: array[0..MAX_DNS_SUFFIX_STRING_LENGTH - 1] of WCHAR;
  end;
 
  // see https://docs.microsoft.com/en-us/window ... _prefix_xp
type
  PIP_ADAPTER_PREFIX_XP = ^TIP_ADAPTER_PREFIX_XP;
 
  TIP_ADAPTER_PREFIX_XP = record
    Alignment: record
      case boolean of
        True: (Alignment: ULONGLONG);
        False: (Length: ULONG;
          FLAGS: DWORD);
    end;
    Next: PIP_ADAPTER_PREFIX_XP;
    Address: TSOCKET_ADDRESS;
    PrefixLength: ULONG;
  end;
 
 
const
  MAX_ADAPTER_ADDRESS_LENGTH = 8;
  MAX_DHCPV6_DUID_LENGTH = 130;
 
  // see https://docs.microsoft.com/de-de/window ... dresses_lh
type
  PIP_ADAPTER_ADDRESSES = ^TIP_ADAPTER_ADDRESSES;
 
  TIP_ADAPTER_ADDRESSES = record
    Alignment: record
      case boolean of
        True: (Alignment: ULONGLONG);
        False: (Length, IfIndex: ULONG);
    end;
    Next: PIP_ADAPTER_ADDRESSES;
    AdapterName: PChar;
    FirstUnicast: PIP_ADAPTER_UNICAST_ADDRESS_LH;
    FirstAnycast: PIP_ADAPTER_ANYCAST_ADDRESS_XP;
    FirstMulticast: PIP_ADAPTER_MULTICAST_ADDRESS_XP;
    FirstDNSServer: PIP_ADAPTER_DNS_SERVER_ADDRESS_XP;
    DnsSuffix: PWCHAR;
    Description: PWCHAR;
    FriendlyName: PWCHAR;
    PhysicalAddress: array[0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of byte;
    PhysicalAddressLength: ULONG;
    Flags: record
      case boolean of
        True: (Flags: boolean);
        False: (BitFlags: bitpacked record
            DdnsEnabled,
            RegisterAdapterSuffix,
            Dhcpv4Enabled,
            ReceiveOnly,
            NoMulticast,
            Ipv6OtherStatefulConfig,
            NetbiosOverTcpipEnabled,
            Ipv4Enabled, Ipv6Enabled,
            Ipv6ManagedAddressConfigurationSupported: boolean;
          end;
        );
    end;
    Mtu: ULONG;
    //Enums in C => Ints/cardinals/ULONGS/32 bit
    IfType: ULONG;
    OperStatus: ULONG;
    Ipv6IFIndex: ULONG;
    ZoneIndices: array[0..15] of ULONG;
    FirstPrefix: PIP_ADAPTER_PREFIX_XP;
    TransmitLinkSpeed,
    ReceiveLinkSpeed: ULONG64;
    FirstGatewayAddress: PIP_ADAPTER_GATEWAY_ADDRESS_LH;
    Ipv4Metric,
    Ipv6Metric: ULONG;
    //IF_LUID
    LUID: ULONG64;
    DHCPv4Server: TSOCKET_ADDRESS;
    // NET_IF_COMPARTMENT_ID = UINT32
    CompartmentId: UInt32;
    NetworkGuid: Windows.GUID;
    // NET_IF_CONNECTION_TYPE, TUNNEL_TYPE = enum
    ConnectionType: ULONG;
    TunnelType: ULONG;
    Dhcpv6Server: TSOCKET_ADDRESS;
    Dhcpv6ClientDuid: array[0..MAX_DHCPV6_DUID_LENGTH - 1] of byte;
    Dhcpv6ClientDuidLength: ULONG;
    Dhcpv6Iaid: ULONG;
    FirstDnsSuffix: PIP_ADAPTER_DNS_SUFFIX;
  end;  

(Hoffentlich korrekt)
Jetzt müsstest du nur noch das Beispiel übersetzen

[sstvmaster]

Hi Warf,

danke für dein Hilfe.
Ich habe mal ein Beispiel zusammen gestoppelt.

Als Netzmaske bekommt man nur den Wert für das Subnet, wie aber in IP-Adresse wandeln?
Es gibt wohl die Funktion "ConvertLengthToIpv4Mask", die gibt es aber nicht.
Und das Gateway habe ich auch nicht gefunden.

Den Broadcast würde ich dann so berechnen:

Code: Alles auswählen

BroadcastInt := IPAddrInt or (not NetMaskInt);

IPv6 geht auch nicht, oder ich bin Blind.

[sstvmaster]

Also Netzmask aus Subnet + Broadcast berechnen:

Code: Alles auswählen

 
program project1;
 
uses
  Classes, synaip;
 
var
  NetMaskReverse,
  NetMask,
  IPStart,
  IPEnd,
  Broadcast,
  Hosts      : Int64;
 
  SubNet     : Integer;
  IPAddress  : String;
 
begin
  IPAddress := '192.168.0.2';
  SubNet    := 24;
 
  NetMask        := 4294967295 shl (32 - SubNet);
  NetMaskReverse := 4294967295 - NetMask;
  Broadcast      := StrToIp(IPAddress) or (not NetMask);
  IPStart        := (StrToIp(IPAddress) and NetMask) + 1;
  IPEnd          := Broadcast - 1;
  Hosts          := NetMaskReverse - 1;
 
  WriteLn( 'IP Address      : ', IPAddress );
  WriteLn( 'Subnet          : ', SubNet );
  WriteLn( 'NetMask         : ', IpToStr(NetMask) );
  WriteLn( 'NetMask Reverse : ', IpToStr(NetMaskReverse) );
  WriteLn( 'Broadcast       : ', IpToStr(Broadcast) );
  WriteLn( 'IP Start        : ', IpToStr(IPStart) );
  WriteLn( 'IP End          : ', IpToStr(IPEnd) );
  WriteLn( 'Hosts           : ', Hosts );
 
  ReadLn;
end.