Výsledky 1 až 10 z 10

Téma: [Delphi] Fce na zjisteni sitove masky k IP v pocitaci

Hybrid View

Předcházející příspěvek Předcházející příspěvek   Další příspěvek Další příspěvek
  1. #1

    Standardní Re: [Delphi] Fce na zjisteni sitove masky k IP v pocitaci

    Citace Původně odeslal Rainbow Zobrazit příspěvek
    Radsej by to chcelo pozriet dokumentaciu (ak existuje) ako naplacat nejaky kod, ktory bude nejako fungovat podla nejakych predpokladov, ktore nemusia byt vzdy pravdive.
    Ceho je soucasti knihovna IPHlpAPI

    Ja pouzivam Delphi 6 PE + ICS (sitove komponenty)

  2. #2

    Standardní Re: [Delphi] Fce na zjisteni sitove masky k IP v pocitaci

    Zdravim,

    zkus se podivat sem http://msdn2.microsoft.com/en-us/library/aa365917.aspx

    Je tam i skoro komplet priklad. Obaleni do object pascalu jako domaci cviceni
    GigaByte GA-M55plus-S3G --- A64 3200+ @ 24oo ~ 1,375V BOX --- 2x512 Geil 667 CL4 @ 980 CL5 --- WD2500KS --- Acer AL1721ms --- 1/1 MBit/s via WiFi
    Blog

    09 F9 11 02 9D 74 E3 5B D8 41 56 C5 63 56 88 C0 aneb jeste ze ty "ochrany" programujou rozumny lidi :]

  3. #3

    Standardní Re: [Delphi] Fce na zjisteni sitove masky k IP v pocitaci

    Nasel jsem toto:

    unit USock;

    interface

    uses Windows, Winsock, Classes;

    {

    This function enumerates all TCP/IP interfaces and
    returns a CRLF separated string containing:

    IP, NetMask, BroadCast-Address, Up/Down status,
    Broadcast support, Loopback

    If you feed this string to a wide TMEMO (to its memo.lines.text
    property) you will see cleary the results.

    To use this you need Win98/ME/2K, 95 OSR 2 or NT service
    pack #3 because WinSock 2 is used (WS2_32.DLL)

    }


    function IsIeUsingOnlineMode : boolean;
    function IsUserOnline : boolean;
    function IsIpPresent : boolean;
    function IsOnlineRas : Boolean;


    function EnumInterfaces(var sInt: string): Boolean;




    { Imported function WSAIOCtl from Winsock 2.0 - Winsock 2 is }
    { available only in Win98/ME/2K and 95 OSR2, NT srv pack #3 }

    function WSAIoctl(s: TSocket; cmd: DWORD; lpInBuffer: PCHAR; dwInBufferLen:
    DWORD;
    lpOutBuffer: PCHAR; dwOutBufferLen: DWORD;
    lpdwOutBytesReturned: LPDWORD;
    lpOverLapped: POINTER;
    lpOverLappedRoutine: POINTER): Integer; stdcall; external 'WS2_32.DLL';

    { Constants taken from C header files }

    const SIO_GET_INTERFACE_LIST = $4004747F;
    IFF_UP = $00000001;
    IFF_BROADCAST = $00000002;
    IFF_LOOPBACK = $00000004;
    IFF_POINTTOPOINT = $00000008;
    IFF_MULTICAST = $00000010;

    type sockaddr_gen = packed record
    AddressIn: sockaddr_in;
    filler: packed array[0..7] of char;
    end;

    type INTERFACE_INFO = packed record
    iiFlags: u_long; // Interface flags
    iiAddress: sockaddr_gen; // Interface address
    iiBroadcastAddress: sockaddr_gen; // Broadcast address
    iiNetmask: sockaddr_gen; // Network mask
    end;


    implementation


    {-------------------------------------------------------------------

    1. Open WINSOCK
    2. Create a socket
    3. Call WSAIOCtl to obtain network interfaces
    4. For every interface, get IP, MASK, BROADCAST, status
    5. Fill a CRLF separated string with this info
    6. Finito

    --------------------------------------------------------------------}

    function EnumInterfaces(var sInt: string): Boolean;
    var s: TSocket;
    wsaD: WSADATA;
    NumInterfaces: Integer;
    BytesReturned, SetFlags: u_long;
    pAddrInet: SOCKADDR_IN;
    pAddrString: PCHAR;
    PtrA: pointer;
    Buffer: array[0..20] of INTERFACE_INFO;
    i: Integer;
    begin
    result := true; // Initialize
    sInt := '';

    WSAStartup($0101, wsaD); // Start WinSock
    // You should normally check
    // for errors here

    s := Socket(AF_INET, SOCK_STREAM, 0); // Open a socket
    if (s = INVALID_SOCKET) then exit;

    try // Call WSAIoCtl
    PtrA := @bytesReturned;
    if (WSAIoCtl(s, SIO_GET_INTERFACE_LIST, nil, 0, @Buffer, 1024, PtrA, nil,
    nil)
    <> SOCKET_ERROR)
    then
    begin // If ok, find out how
    // many interfaces exist

    NumInterfaces := BytesReturned div SizeOf(INTERFACE_INFO);

    for i := 0 to NumInterfaces - 1 do // For every interface
    begin
    pAddrInet := Buffer[i].iiAddress.addressIn; // IP ADDRESS
    pAddrString := inet_ntoa(pAddrInet.sin_addr);
    sInt := sInt + ' IP=' + pAddrString + ',';


    pAddrInet := Buffer[i].iiNetMask.addressIn; // SUBNET MASK
    pAddrString := inet_ntoa(pAddrInet.sin_addr);
    sInt := sInt + ' Mask=' + pAddrString + ',';
    pAddrInet := Buffer[i].iiBroadCastAddress.addressIn; // Broadcast addr
    pAddrString := inet_ntoa(pAddrInet.sin_addr);
    sInt := sInt + ' Broadcast=' + pAddrString + ',';

    SetFlags := Buffer[i].iiFlags;
    if (SetFlags and IFF_UP) = IFF_UP then
    sInt := sInt + ' Interface UP,' // Interface up/down
    else
    sInt := sInt + ' Interface DOWN,';

    if (SetFlags and IFF_BROADCAST) = IFF_BROADCAST then // Broadcasts
    sInt := sInt + ' Broadcasts supported,' // supported or
    else // not supported
    sInt := sInt + ' Broadcasts NOT supported,';

    if (SetFlags and IFF_LOOPBACK) = IFF_LOOPBACK then // Loopback or
    sInt := sInt + ' Loopback interface'
    else
    sInt := sInt + ' Network interface'; // normal

    sInt := sInt + #13#10; // CRLF between
    // each interface
    end;
    end;
    except
    end;
    //
    // Close sockets
    //
    CloseSocket(s);
    WSACleanUp;
    result := false;
    end;

    function IsIpPresent : boolean;
    type
    TApInAddr = array [0..10] of PInAddr;
    PApInAddr = ^TApInAddr;
    var
    Phe : PHostEnt;
    Pptr : PApInAddr;
    Buf : array [0..63] of char;
    i : Integer;
    GInitData : TWsaData;
    Ip : string;
    begin
    Result := FALSE;
    WsaStartup ($101, GInitData);
    GetHostName (Buf, SizeOf(Buf));
    Phe := GetHostByName (Buf);
    if Phe = nil then
    Exit;
    Pptr := PApInAddr(Phe^.h_addr_list);
    i := 0;
    while Pptr^[i] <> nil do
    begin
    Ip := inet_ntoa(Pptr^[i]^);
    Inc(i);
    end;
    WsaCleanup;
    Result := (Ip <> '') and (Ip <> '127.0.0.1');
    end;

    //--------------------------------------------------------------------------


    function IsOnlineRas : boolean;
    const
    REG_RAS_BASE = 'System\CurrentControlSet\Services\RemoteAccess';
    REG_RAS_RC = 'Remote Connection';
    var
    OpenKey : HKEY;
    DataType,
    DataSize,
    Buf : DWORD;
    begin
    Result := FALSE;
    if RegOpenKeyEx (HKEY_LOCAL_MACHINE, REG_RAS_BASE,
    REG_OPTION_NON_VOLATILE,
    KEY_READ, OpenKey) = ERROR_SUCCESS then
    begin
    DataType := REG_BINARY;
    DataSize := SizeOf(Buf);
    if RegQueryValueEx (OpenKey, REG_RAS_RC, nil, @DataType, @Buf,
    @DataSize) =
    ERROR_SUCCESS then
    Result := (Buf = 1);
    RegCloseKey (OpenKey);
    end;
    end;

    //--------------------------------------------------------------------------


    function IsIeUsingOnlineMode : boolean;
    var
    InetIsOffline : function (dwFlags : DWORD) : bool; stdcall;
    HLib : THandle;

    function GetBasicOsVer : integer;
    var
    VerInfo : TOsVersionInfo;
    begin
    VerInfo.dwOSVersionInfoSize := SizeOf(TOsVersionInfo);
    if GetVersionEx (VerInfo) then
    begin
    case VerInfo.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS : Result := 1;
    VER_PLATFORM_WIN32_NT : Result := 2;
    else
    Result := 0;
    end;
    end
    else
    Result := 0;
    end;

    //
    // Win9x stores the InetIsOffline API in SHELL32.DLL while NT stores it in
    // URL.DLL
    //
    function GetProperLibHandle : THandle;
    begin
    case GetBasicOsVer of
    1 : Result := LoadLibrary ('SHELL32.DLL');
    2 : Result := LoadLibrary ('URL.DLL');
    else
    Result := INVALID_HANDLE_VALUE;
    end;
    end;

    begin
    Result := FALSE;
    HLib := GetProperLibHandle;
    if HLib <> INVALID_HANDLE_VALUE then
    try
    @InetIsOffline := GetProcAddress (HLib, 'InetIsOffline');
    if @InetIsOffline <> nil then
    Result := not (InetIsOffline (0));
    finally
    FreeLibrary (HLib);
    end;
    end;

    //--------------------------------------------------------------------------


    function IsUserOnline : boolean;
    begin
    Result := IsIpPresent or IsOnlineRas or IsIeUsingOnlineMode;
    end;


    end.

    ma jednu vadu, otevira to WinSock, ktery mam jiz otevreny jinymi VCL knihovnami.

Informace o tématu

Users Browsing this Thread

Toto téma si právě prohlíží 1 uživatelů. (0 registrovaných a 1 anonymních)

Podobná témata

  1. FAQ DvD to DivX
    Založil AjsTi v sekci fóra Programy a problémy s nimi
    Odpovědí: 186
    Poslední příspěvek: 04.01.2010, 20:56
  2. Digitalni zrcadlovka
    Založil Commander v sekci fóra Nákupní poradna
    Odpovědí: 87
    Poslední příspěvek: 26.03.2006, 13:19
  3. Váš názor na starší notebook-viz více v dalším popisu...
    Založil Nvidia fanda v sekci fóra Notebooky
    Odpovědí: 37
    Poslední příspěvek: 15.01.2005, 21:48
  4. Odešlo chlazení na GF3Ti500 - jaké nové ??
    Založil pinky v sekci fóra NVIDIA grafické karty
    Odpovědí: 1
    Poslední příspěvek: 07.01.2003, 19:22
  5. Redukce PowerLeap Tualatin/Slot1
    Založil homberg v sekci fóra Intel procesory
    Odpovědí: 24
    Poslední příspěvek: 24.10.2002, 09:39

Pravidla přispívání

  • Nemůžete zakládat nová témata
  • Nemůžete zasílat odpovědi
  • Nemůžete přikládat přílohy
  • Nemůžete upravovat své příspěvky
  •