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

    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 :]

  2. #2

    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, 21:56
  2. Digitalni zrcadlovka
    Založil Commander v sekci fóra Nákupní poradna
    Odpovědí: 87
    Poslední příspěvek: 26.03.2006, 14: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, 22: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, 20: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, 10: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
  •