zoukankan      html  css  js  c++  java
  • delphi网络函数大全

    {=========================================================================
    功 能: 网络函数库
    时 间: 2002/10/02
    版 本: 1.0
    =========================================================================}
    unit Net;

    interface
    uses
    SysUtils
    ,Windows
    ,dialogs
    ,winsock
    ,Classes
    ,ComObj
    ,WinInet;

    //得到本机的局域网Ip地址
    Function GetLocalIp(var LocalIp:string): Boolean;
    //通过Ip返回机器名
    Function GetNameByIPAddr(IPAddr: string; var MacName: string): Boolean ;
    //获取网络中SQLServer列表
    Function GetSQLServerList(var List: Tstringlist): Boolean;
    //获取网络中的所有网络类型
    Function GetNetList(var List: Tstringlist): Boolean;
    //获取网络中的工作组
    Function GetGroupList(var List: TStringList): Boolean;
    //获取工作组中所有计算机
    Function GetUsers(GroupName: string; var List: TStringList): Boolean;
    //获取网络中的资源
    Function GetUserResource(IpAddr: string; var List: TStringList): Boolean;
    //映射网络驱动器
    Function NetAddConnection(NetPath: Pchar; PassWord: Pchar;LocalPath: Pchar): Boolean;
    //检测网络状态
    Function CheckNet(IpAddr:string): Boolean;
    //检测机器是否登入网络
    Function CheckMacAttachNet: Boolean;

    //判断Ip协议有没有安装 这个函数有问题
    Function IsIPInstalled : boolean;
    //检测机器是否上网
    Function InternetConnected: Boolean;
    implementation

    {=================================================================
    功 能: 检测机器是否登入网络
    参 数: 无
    返回值: 成功: True 失败: False
    备 注:
    版 本:
    1.0 2002/10/03 09:55:00
    =================================================================}
    Function CheckMacAttachNet: Boolean;
    begin
    Result := False;
    if GetSystemMetrics(SM_NETWORK) <> 0 then
    Result := True;
    end;

    {=================================================================
    功 能: 返回本机的局域网Ip地址
    参 数: 无
    返回值: 成功: True, 并填充LocalIp 失败: False
    备 注:
    版 本:
    1.0 2002/10/02 21:05:00
    =================================================================}
    function GetLocalIP(var LocalIp: string): Boolean;
    var
    HostEnt: PHostEnt;
    Ip: string;
    addr: pchar;
    Buffer: array [0..63] of char;
    GInitData: TWSADATA;
    begin
    Result := False;
    try
    WSAStartup(2, GInitData);
    GetHostName(Buffer, SizeOf(Buffer));
    HostEnt := GetHostByName(buffer);
    if HostEnt = nil then Exit;
    addr := HostEnt^.h_addr_list^;
    ip := Format('%d.%d.%d.%d', [byte(addr [0]),
    byte (addr [1]), byte (addr [2]), byte (addr [3])]);
    LocalIp := Ip;
    Result := True;
    finally
    WSACleanup;
    end;
    end;

    {=================================================================
    功 能: 通过Ip返回机器名
    参 数:
    IpAddr: 想要得到名字的Ip
    返回值: 成功: 机器名 失败: ''
    备 注:
    inet_addr function converts a string containing an Internet
    Protocol dotted address into an in_addr.
    版 本:
    1.0 2002/10/02 22:09:00
    =================================================================}
    function GetNameByIPAddr(IPAddr : String;var MacName:String): Boolean;
    var
    SockAddrIn: TSockAddrIn;
    HostEnt: PHostEnt;
    WSAData: TWSAData;
    begin
    Result := False;
    if IpAddr = '' then exit;
    try
    WSAStartup(2, WSAData);
    SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));
    HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
    if HostEnt <> nil then
    MacName := StrPas(Hostent^.h_name);
    Result := True;
    finally
    WSACleanup;
    end;
    end;

    {=================================================================
    功 能: 返回网络中SQLServer列表
    参 数:
    List: 需要填充的List
    返回值: 成功: True,并填充List 失败 False
    备 注:
    版 本:
    1.0 2002/10/02 22:44:00
    =================================================================}
    Function GetSQLServerList(var List: Tstringlist): boolean;
    var
    i: integer;
    sRetValue: String;
    SQLServer: Variant;
    ServerList: Variant;
    begin
    Result := False;
    List.Clear;
    try
    SQLServer := CreateOleObject('SQLDMO.Application');
    ServerList := SQLServer.ListAvailableSQLServers;
    for i := 1 to Serverlist.Count do
    list.Add (Serverlist.item(i));
    Result := True;
    Finally
    SQLServer := NULL;
    ServerList := NULL;
    end;
    end;

    {=================================================================
    功 能: 判断Ip协议有没有安装
    参 数: 无
    返回值: 成功: True 失败: False;
    备 注: 该函数还有问题
    版 本:
    1.0 2002/10/02 21:05:00
    =================================================================}
    Function IsIPInstalled : boolean;
    var
    WSData: TWSAData;
    ProtoEnt: PProtoEnt;
    begin
    Result := True;
    try
    if WSAStartup(2,WSData) = 0 then
    begin
    ProtoEnt := GetProtoByName('IP');
    if ProtoEnt = nil then
    Result := False
    end;
    finally
    WSACleanup;
    end;
    end;
    {=================================================================
    功 能: 返回网络中的共享资源
    参 数:
    IpAddr: 机器Ip
    List: 需要填充的List
    返回值: 成功: True,并填充List 失败: False;
    备 注:
    WNetOpenEnum function starts an enumeration of network
    resources or existing connections.
    WNetEnumResource function continues a network-resource
    enumeration started by the WNetOpenEnum function.
    版 本:
    1.0 2002/10/03 07:30:00
    =================================================================}
    Function GetUserResource(IpAddr: string; var List: TStringList): Boolean;
    type
    TNetResourceArray = ^TNetResource;//网络类型的数组
    Var
    i: Integer;
    Buf: Pointer;
    Temp: TNetResourceArray;
    lphEnum: THandle;
    NetResource: TNetResource;
    Count,BufSize,Res: DWord;
    Begin
    Result := False;
    List.Clear;
    if copy(Ipaddr,0,2) <> '\\' then
    IpAddr := '\\'+IpAddr; //填充Ip地址信息
    FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息
    NetResource.lpRemoteName := @IpAddr[1];//指定计算机名称
    //获取指定计算机的网络资源句柄
    Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
    RESOURCEUSAGE_CONNECTABLE, @NetResource,lphEnum);
    if Res <> NO_ERROR then exit;//执行失败
    while True do//列举指定工作组的网络资源
    begin
    Count := $FFFFFFFF;//不限资源数目
    BufSize := 8192;//缓冲区大小设置为8K
    GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
    //获取指定计算机的网络资源名称
    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
    if Res = ERROR_NO_MORE_ITEMS then break;//资源列举完毕
    if (Res <> NO_ERROR) then Exit;//执行失败
    Temp := TNetResourceArray(Buf);
    for i := 0 to Count - 1 do
    begin
    //获取指定计算机中的共享资源名称,+2表示删除"\\",
    //如\\192.168.0.1 => 192.168.0.1
    List.Add(Temp^.lpRemoteName + 2);
    Inc(Temp);
    end;
    end;
    Res := WNetCloseEnum(lphEnum);//关闭一次列举
    if Res <> NO_ERROR then exit;//执行失败
    Result := True;
    FreeMem(Buf);
    End;

    {=================================================================
    功 能: 返回网络中的工作组
    参 数:
    List: 需要填充的List
    返回值: 成功: True,并填充List 失败: False;
    备 注:
    版 本:
    1.0 2002/10/03 08:00:00
    =================================================================}
    Function GetGroupList( var List : TStringList ) : Boolean;
    type
    TNetResourceArray = ^TNetResource;//网络类型的数组
    Var
    NetResource: TNetResource;
    Buf: Pointer;
    Count,BufSize,Res: DWORD;
    lphEnum: THandle;
    p: TNetResourceArray;
    i,j: SmallInt;
    NetworkTypeList: TList;
    Begin
    Result := False;
    NetworkTypeList := TList.Create;
    List.Clear;
    //获取整个网络中的文件资源的句柄,lphEnum为返回名柄
    Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
    RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
    if Res <> NO_ERROR then exit;//Raise Exception(Res);//执行失败
    //获取整个网络中的网络类型信息
    Count := $FFFFFFFF;//不限资源数目
    BufSize := 8192;//缓冲区大小设置为8K
    GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
    //资源列举完毕 //执行失败
    if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR ) then Exit;
    P := TNetResourceArray(Buf);
    for i := 0 to Count - 1 do//记录各个网络类型的信息
    begin
    NetworkTypeList.Add(p);
    Inc(P);
    end;
    Res := WNetCloseEnum(lphEnum);//关闭一次列举
    if Res <> NO_ERROR then exit;
    for j := 0 to NetworkTypeList.Count-1 do //列出各个网络类型中的所有工作组名称
    begin//列出一个网络类型中的所有工作组名称
    NetResource := TNetResource(NetworkTypeList.Items[J]^);//网络类型信息
    //获取某个网络类型的文件资源的句柄,NetResource为网络类型信息,lphEnum为返回名柄
    Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
    RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
    if Res <> NO_ERROR then break;//执行失败
    while true do//列举一个网络类型的所有工作组的信息
    begin
    Count := $FFFFFFFF;//不限资源数目
    BufSize := 8192;//缓冲区大小设置为8K
    GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
    //获取一个网络类型的文件资源信息,
    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
    //资源列举完毕 //执行失败
    if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR) then break;
    P := TNetResourceArray(Buf);
    for i := 0 to Count - 1 do//列举各个工作组的信息
    begin
    List.Add( StrPAS( P^.lpRemoteName ));//取得一个工作组的名称
    Inc(P);
    end;
    end;
    Res := WNetCloseEnum(lphEnum);//关闭一次列举
    if Res <> NO_ERROR then break;//执行失败
    end;
    Result := True;
    FreeMem(Buf);
    NetworkTypeList.Destroy;
    End;

    {=================================================================
    功 能: 列举工作组中所有的计算机
    参 数:
    List: 需要填充的List
    返回值: 成功: True,并填充List 失败: False;
    备 注:
    版 本:
    1.0 2002/10/03 08:00:00
    =================================================================}
    Function GetUsers(GroupName: string; var List: TStringList): Boolean;
    type
    TNetResourceArray = ^TNetResource;//网络类型的数组
    Var
    i: Integer;
    Buf: Pointer;
    Temp: TNetResourceArray;
    lphEnum: THandle;
    NetResource: TNetResource;
    Count,BufSize,Res: DWord;
    begin
    Result := False;
    List.Clear;
    FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息
    NetResource.lpRemoteName := @GroupName[1];//指定工作组名称
    NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;//类型为服务器(工作组)
    NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;
    NetResource.dwScope := RESOURCETYPE_DISK;//列举文件资源信息
    //获取指定工作组的网络资源句柄
    Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
    RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
    if Res <> NO_ERROR then Exit; //执行失败
    while True do//列举指定工作组的网络资源
    begin
    Count := $FFFFFFFF;//不限资源数目
    BufSize := 8192;//缓冲区大小设置为8K
    GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
    //获取计算机名称
    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
    if Res = ERROR_NO_MORE_ITEMS then break;//资源列举完毕
    if (Res <> NO_ERROR) then Exit;//执行失败
    Temp := TNetResourceArray(Buf);
    for i := 0 to Count - 1 do//列举工作组的计算机名称
    begin
    //获取工作组的计算机名称,+2表示删除"\\",如\\wangfajun=>wangfajun
    List.Add(Temp^.lpRemoteName + 2);
    inc(Temp);
    end;
    end;
    Res := WNetCloseEnum(lphEnum);//关闭一次列举
    if Res <> NO_ERROR then exit;//执行失败
    Result := True;
    FreeMem(Buf);
    end;

    {=================================================================
    功 能: 列举所有网络类型
    参 数:
    List: 需要填充的List
    返回值: 成功: True,并填充List 失败: False;
    备 注:
    版 本:
    1.0 2002/10/03 08:54:00
    =================================================================}
    Function GetNetList(var List: Tstringlist): Boolean;
    type
    TNetResourceArray = ^TNetResource;//网络类型的数组
    Var
    p: TNetResourceArray;
    Buf: Pointer;
    i: SmallInt;
    lphEnum: THandle;
    NetResource: TNetResource;
    Count,BufSize,Res: DWORD;
    begin
    Result := False;
    List.Clear;
    Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
    RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
    if Res <> NO_ERROR then exit;//执行失败
    Count := $FFFFFFFF;//不限资源数目
    BufSize := 8192;//缓冲区大小设置为8K
    GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);//获取网络类型信息
    //资源列举完毕 //执行失败
    if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR ) then Exit;
    P := TNetResourceArra

    {=================================================================
    功 能: 映射网络驱动器
    参 数:
    NetPath: 想要映射的网络路径
    Password: 访问密码
    Localpath 本地路径
    返回值: 成功: True 失败: False;
    备 注:
    版 本:
    1.0 2002/10/03 09:24:00
    =================================================================}
    Function NetAddConnection(NetPath: Pchar; PassWord: Pchar
    ;LocalPath: Pchar): Boolean;
    var
    Res: Dword;
    begin
    Result := False;
    Res := WNetAddConnection(NetPath,Password,LocalPath);
    if Res <> No_Error then exit;
    Result := True;
    end;

    {=================================================================
    功 能: 检测网络状态
    参 数:
    IpAddr: 被测试网络上主机的IP地址或名称,建议使用Ip
    返回值: 成功: True 失败: False;
    备 注:
    版 本:
    1.0 2002/10/03 09:40:00
    =================================================================}
    Function CheckNet(IpAddr: string): Boolean;
    type
    PIPOptionInformation = ^TIPOptionInformation;
    TIPOptionInformation = packed record
    TTL: Byte; // Time To Live (used for traceroute)
    TOS: Byte; // Type Of Service (usually 0)
    Flags: Byte; // IP header flags (usually 0)
    OptionsSize: Byte; // Size of options data (usually 0, max 40)
    OptionsData: PChar; // Options data buffer
    end;

    PIcmpEchoReply = ^TIcmpEchoReply;
    TIcmpEchoReply = packed record
    Address: DWord; // replying address
    Status: DWord; // IP status value (see below)
    RTT: DWord; // Round Trip Time in milliseconds
    DataSize: Word; // reply data size
    Reserved: Word;
    Data: Pointer; // pointer to reply data buffer
    Options: TIPOptionInformation; // reply options
    end;

    TIcmpCreateFile = function: THandle; stdcall;
    TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
    TIcmpSendEcho = function(
    IcmpHandle: THandle;
    DestinationAddress: DWord;
    RequestData: Pointer;
    RequestSize: Word;
    RequestOptions: PIPOptionInformation;
    ReplyBuffer: Pointer;
    ReplySize: DWord;
    Timeout: DWord
    ): DWord; stdcall;

    const
    Size = 32;
    TimeOut = 1000;
    var
    wsadata: TWSAData;
    Address: DWord; // Address of host to contact
    HostName, HostIP: String; // Name and dotted IP of host to contact
    Phe: PHostEnt; // HostEntry buffer for name lookup
    BufferSize, nPkts: Integer;
    pReqData, pData: Pointer;
    pIPE: PIcmpEchoReply; // ICMP Echo reply buffer
    IPOpt: TIPOptionInformation; // IP Options for packet to send
    const
    IcmpDLL = 'icmp.dll';
    var
    hICMPlib: HModule;
    IcmpCreateFile : TIcmpCreateFile;
    IcmpCloseHandle: TIcmpCloseHandle;
    IcmpSendEcho: TIcmpSendEcho;
    hICMP: THandle; // Handle for the ICMP Calls
    begin
    // initialise winsock
    Result:=True;
    if WSAStartup(2,wsadata) <> 0 then begin
    Result:=False;
    halt;
    end;
    // register the icmp.dll stuff
    hICMPlib := loadlibrary(icmpDLL);
    if hICMPlib <> null then begin
    @ICMPCreateFile := GetProcAddress(hICMPlib, 'IcmpCreateFile');
    @IcmpCloseHandle:= GetProcAddress(hICMPlib, 'IcmpCloseHandle');
    @IcmpSendEcho:= GetProcAddress(hICMPlib, 'IcmpSendEcho');
    if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then begin
    Result:=False;
    halt;
    end;
    hICMP := IcmpCreateFile;
    if hICMP = INVALID_HANDLE_VALUE then begin
    Result:=False;
    halt;
    end;
    end else begin
    Result:=False;
    halt;
    end;
    // ------------------------------------------------------------
    Address := inet_addr(PChar(IpAddr));
    if (Address = INADDR_NONE) then begin
    Phe := GetHostByName(PChar(IpAddr));
    if Phe = Nil then Result:=False
    else begin
    Address := longint(plongint(Phe^.h_addr_list^)^);
    HostName := Phe^.h_name;
    HostIP := StrPas(inet_ntoa(TInAddr(Address)));
    end;
    end
    else begin
    Phe := GetHostByAddr(@Address, 4, PF_INET);
    if Phe = Nil then Result:=False;
    end;

    if Address = INADDR_NONE then
    begin
    Result:=False;
    end;
    // Get some data buffer space and put something in the packet to send
    BufferSize := SizeOf(TICMPEchoReply) + Size;
    GetMem(pReqData, Size);
    GetMem(pData, Size);
    GetMem(pIPE, BufferSize);
    FillChar(pReqData^, Size, $AA);
    pIPE^.Data := pData;

    // Finally Send the packet
    FillChar(IPOpt, SizeOf(IPOpt), 0);
    IPOpt.TTL := 64;
    NPkts := IcmpSendEcho(hICMP, Address, pReqData, Size,
    @IPOpt, pIPE, BufferSize, TimeOut);
    if NPkts = 0 then Result:=False;

    // Free those buffers
    FreeMem(pIPE); FreeMem(pData); FreeMem(pReqData);

    // --------------------------------------------------------------
    IcmpCloseHandle(hICMP);
    FreeLibrary(hICMPlib);
    // free winsock
    if WSACleanup <> 0 then Result:=False;
    end;


    {=================================================================
    功 能: 检测计算机是否上网
    参 数: 无
    返回值: 成功: True 失败: False;
    备 注: uses Wininet
    版 本:
    1.0 2002/10/07 13:33:00
    =================================================================}
    function InternetConnected: Boolean;
    const
    // local system uses a modem to connect to the Internet.
    INTERNET_CONNECTION_MODEM = 1;
    // local system uses a local area network to connect to the Internet.
    INTERNET_CONNECTION_LAN = 2;
    // local system uses a proxy server to connect to the Internet.
    INTERNET_CONNECTION_PROXY = 4;
    // local system's modem is busy with a non-Internet connection.
    INTERNET_CONNECTION_MODEM_BUSY = 8;
    var
    dwConnectionTypes : DWORD;
    begin
    dwConnectionTypes := INTERNET_CONNECTION_MODEM+ INTERNET_CONNECTION_LAN
    + INTERNET_CONNECTION_PROXY;
    Result := InternetGetConnectedState(@dwConnectionTypes, 0);
    end;

    end.

    /////////////////////////////*******************************************//错误信息常量
    unit Head;

    interface
    const
    C_Err_GetLocalIp = '获取本地ip失败';
    C_Err_GetNameByIpAddr = '获取主机名失败';
    C_Err_GetSQLServerList = '获取SQLServer服务器失败';
    C_Err_GetUserResource = '获取共享资失败';
    C_Err_GetGroupList = '获取所有工作组失败';
    C_Err_GetGroupUsers = '获取工作组中所有计算机失败';
    C_Err_GetNetList = '获取所有网络类型失败';
    C_Err_CheckNet = '网络不通';
    C_Err_CheckAttachNet = '未登入网络';
    C_Err_InternetConnected ='没有上网';

    C_Txt_CheckNetSuccess = '网络畅通';
    C_Txt_CheckAttachNetSuccess = '已登入网络';
    C_Txt_InternetConnected ='上网了';

    implementation

    end.
  • 相关阅读:
    背水一战 Windows 10 (26)
    背水一战 Windows 10 (25)
    背水一战 Windows 10 (24)
    背水一战 Windows 10 (23)
    背水一战 Windows 10 (22)
    背水一战 Windows 10 (21)
    背水一战 Windows 10 (20)
    背水一战 Windows 10 (19)
    背水一战 Windows 10 (18)
    背水一战 Windows 10 (17)
  • 原文地址:https://www.cnblogs.com/94YY/p/2043522.html
Copyright © 2011-2022 走看看