网络函数库

{=========================================================================
   功  能: 网络函数库
   时  间: SilverLong 2005/10/09
   版  本: 1.0
   备  注:
=========================================================================}

unit NetFunction;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Mask, ImgList, ToolWin ,winsock,
  ComObj,WinInet,Registry, Buttons, Menus,DB,Adodb;


  //功  能: 获取本机的IP地址
  Function GetIP: string;

  //得到本机的局域网Ip地址
  Function GetLocalIp(var LocalIp:string): Boolean;
  //通过Ip返回机器名
  Function GetNameByIPAddr(IPAddr: string; var MacName: string): Boolean ;
  //获取网络中SQLServer列表
  Function GetSQLServerList(var List: Tstringlist): Boolean;

  //获取网络中SQLServer列表
  Function GetSQLServerCom(var SQLComboBox: TComboBox): boolean;

  //获取网络中SQLServer中数据库名列表(根据use master select * from dbo.sysdatabases获取)
  Function GetDataBaseName(var Query: TADOQuery): TStringList;

  //获取网络中SQLServer中数据库表的表名列表 (根据select * from sysobjects where xtype='U'获取)
  Function GetTableName(var Query: TADOQuery): TStringList;

  //获取网络中SQLServer中数据库表的列名、类型和长度 列表
  //备 注:   根据select name (or Type or Length)  from syscolumns a ,sysobjects b
  //             where a.id=b.id and b.xtype='U' and b.name='表名参数'获取数据
  Function GetColValues(var Query: TADOQuery;TBName:String;nType:String): TStrings;
  

  //获取网络中的所有网络类型
  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;

  //处理登陆共享目录错误信息
  procedure CallNetExtError;
  //处理登陆共享目录
  function WinLoginNet(ShareDir,ServerIp,ServerUserPWD,ServerUserName : String):BooLean;

implementation

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

{=================================================================
  功  能: 返回本机的局域网Ip地址
  参  数: 无
  返回值: 成功:  True, 并填充LocalIp   失败:  False
  备 注:
  版 本:
     1.0  2005/10/09 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  2005/10/09 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;


{=================================================================
  功  能: 获取本机的IP地址
  参  数:无
  返回值: 返回本机的IP地址
  备 注:
  版 本:
    1.0  2002/10/02 22:44:00
=================================================================}
function GetIP: string;
type
        TaPInAddr = array [0..10] of PInAddr;
        PaPInAddr = ^TaPInAddr;
var
        phe  : PHostEnt;
        pptr : PaPInAddr;
        Buffer : array [0..63] of char;
        I    : Integer;
        GInitData      : TWSADATA;
begin
        WSAStartup($101, GInitData);
        Result := '';
        GetHostName(Buffer, SizeOf(Buffer));
        phe :=GetHostByName(buffer);
        if phe = nil then Exit;
        pptr := PaPInAddr(Phe^.h_addr_list);
        I := 0;
        while pptr^[I] <> nil do
        begin
                result:=StrPas(inet_ntoa(pptr^[I]^));
                Inc(I);
        end;
        WSACleanup;
end;

{=================================================================
  功  能: 返回网络中SQLServer列表
  参  数:
          List: 需要填充的List
  返回值: 成功:  True,并填充List  失败 False
  备 注:
  版 本:
    1.0  2005/10/09 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  := 0;
                ServerList := 0;
        end;
end;

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

{=================================================================
  功  能: 判断Ip协议有没有安装
  参  数: 无
  返回值: 成功:  True 失败: False;
  备 注:   该函数还有问题
  版 本:
     1.0  2005/10/09 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  2005/10/10 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  2005/10/10 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  2005/10/10 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  2005/10/10 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 := TNetResourceArray(Buf);
end;

{=================================================================
  功  能: 映射网络驱动器
  参  数:
          NetPath: 想要映射的网络路径
          Password: 访问密码
          Localpath 本地路径
  返回值: 成功:  True  失败: False;
  备 注:
  版 本:
     1.0  2005/10/10 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  2005/10/10 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 <> 0 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  2005/10/10 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;

{=================================================================
  功  能:  处理登陆共享目录错误信息
  参  数:  无
  返回值:  无
  备 注:   uses Wininet
  版 本:
     1.0  2005/10/10 13:33:00
=================================================================}
procedure CallNetExtError;
var
        ErrorCode: Cardinal;
        ErrBuf,NameBuf: string;
        ShowMsg: string;
begin
        SetLength(ErrBuf,MAX_PATH);
        SetLength(NameBuf,MAX_PATH);
        if WNetGetLastError(ErrorCode,PChar(ErrBuf),MAX_PATH+1,PChar(NameBuf),MAX_PATH+1) = NO_ERROR then
        begin
                ShowMsg := 'Error Code:' + IntToStr(ErrorCode) + #13#10;
                ShowMsg := ShowMsg + 'Error String:' + ErrBuf + #13#10;
                ShowMsg := ShowMsg + 'Error Provider:' + NameBuf;
                ShowMessage(ShowMsg);
        end;
end;


{=================================================================
  功  能:  处理登陆共享目录
  参  数:  ShareDir共享目录,
           ServerIp服务器IP,
           ServerUserPWD服务器密码,
           ServerUserName服务器登录名
  返回值:  成功:  True  失败: False;
  备 注:   uses WinLoginNet
  版 本:
     1.0  2005/10/10 13:33:00
=================================================================}
function WinLoginNet(ShareDir,ServerIp,ServerUserPWD,ServerUserName : String):BooLean;
var
    NR: NETRESOURCE;
    Ret: DWORD;
    S: string;
    NetDir:Integer;
    f: TSearchRec;
begin
    NetDir:=FindFirst(ShareDir+'*.log', faAnyFile, f);
    if NetDir<>0 then
    begin
         S := '//'+ServerIp;
         NR.dwType := RESOURCETYPE_ANY;
         NR.lpLocalName := nil;
         NR.lpRemoteName := PChar(S);
         NR.lpProvider := nil;
         //调用WNetAddConnection2,此函数在windows单元中,建立永久连接
         Ret := WNetAddConnection2(NR,PChar(ServerUserPWD),PChar(ServerUserName),CONNECT_UPDATE_PROFILE);

         if Ret <> NO_ERROR then
         begin
           if Ret <> 1208 then RaiseLastWin32Error
           else CallNetExtError;
         end;
    end;
end;


procedure ExecuteSql(var Query: TADOQuery;SQL:String);
begin
        try
                Query.Active:=False;
                Query.SQL.Clear;
                Query.SQL.Add(SQL);
                Query.ExecSQL;
        except

        end;
end;

{=================================================================
  功  能:  获取网络中SQLServer中数据库名列表
  参  数:  Query(数据集)
  返回值:  TStringList(数据库名列表)
  备 注:   根据use master select * from dbo.sysdatabases获取
  版 本:
     1.0  2005/10/10 13:33:00
=================================================================}
Function GetDataBaseName(var Query: TADOQuery): TStringList;
Begin

End;


{=================================================================
  功  能:  获取网络中SQLServer数据库中数据表名列表
  参  数:  Query(数据集)
  返回值:  TStringList(数据库名列表)
  备 注:   根据select * from sysobjects where xtype='U'获取
  版 本:
     1.0  2005/10/10 13:33:00
=================================================================}
Function GetTableName(var Query: TADOQuery): TStringList;
Begin

End;


{=================================================================
  功  能:  获取网络中SQLServer中数据库表的列名、类型和长度 列表
  参  数:  Query(数据集)
           TBName(表名)
           nType(参数:name--列名 Type--类型 Length--长度)
  返回值:  TStringList(数据库名列表)
  备 注:   根据select name (or Type or Length)  from syscolumns a ,sysobjects b
               where a.id=b.id and b.xtype='U' and b.name='表名参数'获取数据
  版 本:
     1.0  2005/10/10 13:33:00
=================================================================}
Function GetColValues(var Query: TADOQuery;TBName:String;nType:String): TStrings;
var List : TStringList;
    SQL  : String;
Begin
        List:=TStringList.Create;
        SQL:='';
        SQL:='select a.'+ nType +' from syscolumns a ,sysobjects b ';
        SQL:=SQL + ' where a.id=b.id and b.xtype=''U'' and b.name=''';
        SQL:=SQL + TBName + '''';
       
        Try
                List.Clear;
                Query.Active:=false;
                Query.SQL.Clear;
                Query.SQL.Add(SQL);
                Query.Open;
                while Not Query.Eof do
                Begin
                        List.Add(Query.FieldByName(nType).Value);
                        Query.Next;
                End;
                Result:=List;
        Finally
                //List.Free;
                Query.Close;
        End;
ENd;


end.

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值