| « | February 2026 | » | | 日 | 一 | 二 | 三 | 四 | 五 | 六 | | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | |
|
公告 |
| 暂无公告... |
| Blog信息 |
|
blog名称:DeathCat的猫窝
日志总数:17
评论数量:89
留言数量:0
访问次数:219654
建立时间:2005年4月5日 |
| |
|
 [Delphi食堂]懒人函数 之 “网络应用”
网上资源, 软件技术
DeathCat 发表于 2005/4/6 11:19:58 |
| 这些函数是朋友Sea提供，DeathCat整理。。
因为是网上收集的，所以不晓得原作者~~
向原作者发出崇高的敬意~~
多余的话就不说了，大家拿去用吧
procedure getsharefolder(const computername:string);var //----获取某一计算机上的共享目录 errcode,a:integer; netres:array[0..1023] of netresource; enumhandle:thandle; enumentries,buffersize:dword; s:string; mylistitems:tlistitems; mylistitem:tlistitem; mystrings:tstringlist;begin with netres[0] do begin dwscope :=RESOURCE_GLOBALNET; dwtype :=RESOURCETYPE_DISK; dwdisplaytype :=RESOURCEDISPLAYTYPE_SHARE; dwusage :=RESOURCEUSAGE_CONTAINER; lplocalname :=nil; lpremotename :=pchar(computername); lpcomment :=nil; lpprovider :=nil; end; // 获取根结点 errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER,@netres[0],enumhandle); if errcode=NO_ERROR then begin EnumEntries:=1024; BufferSize:=SizeOf(NetRes); ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize); end; wnetcloseenum(enumhandle); a:=0; mylistitems:=controlcenter.lstfile.Items mylistitems.Clear while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do begin with mylistitems do begin mylistitem:=add; mylistitem.ImageIndex :=4; mylistitem.Caption :=extractfilename(netres[a].lpremotename); end; a:=a+1; end;end;
procedure getnethood();//NT做服务器，WIN98上调试通过。var // ---获取网上邻居 a,i:integer; errcode:integer; netres:array[0..1023] of netresource; enumhandle:thandle; enumentries:dword; buffersize:dword; s:string; mylistitems:tlistitems; mylistitem:tlistitem; alldomain:tstrings;begin //listcomputer is a listview to list all computers;controlcenter is a form. alldomain:=tstringlist.Create with netres[0] do begin dwscope :=RESOURCE_GLOBALNET; dwtype :=RESOURCETYPE_ANY; dwdisplaytype :=RESOURCEDISPLAYTYPE_DOMAIN; dwusage :=RESOURCEUSAGE_CONTAINER; lplocalname :=nil; lpremotename :=nil; lpcomment :=nil; lpprovider :=nil; end; // 获取所有的域 errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@netres[0],enumhandle); if errcode=NO_ERROR then begin enumentries:=1024; buffersize:=sizeof(netres); errcode:=wnetenumresource(enumhandle,enumentries,@netres[0],buffersize); end; a:=0; mylistitems :=controlcenter.lstcomputer.Items mylistitems.Clear while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do begin alldomain.Add (netres[a].lpremotename); a:=a+1; end; wnetcloseenum(enumhandle);// 获取所有的计算机 mylistitems :=controlcenter.lstcomputer.Items mylistitems.Clear for i:=0 to alldomain.Count-1 do begin with netres[0] do begin dwscope :=RESOURCE_GLOBALNET; dwtype :=RESOURCETYPE_ANY; dwdisplaytype :=RESOURCEDISPLAYTYPE_SERVER; dwusage :=RESOURCEUSAGE_CONTAINER; lplocalname :=nil; lpremotename :=pchar(alldomain); lpcomment :=nil; lpprovider :=nil; end; ErrCode:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@netres[0],EnumHandle); if errcode=NO_ERROR then begin EnumEntries:=1024; BufferSize:=SizeOf(NetRes); ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize); end; a:=0; while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do begin mylistitem :=mylistitems.Add mylistitem.ImageIndex :=0; mylistitem.Caption :=uppercase(stringreplace(string(NetRes[a].lpremotename),'\\','',[rfReplaceAll])); a:=a+1; end; wnetcloseenum(enumhandle); end;end;
function GetDomainName(Ip:string):string;var //---实现IP到域名的转换 pH:PHostent; data:twsadata; ii:dword;begin WSAStartup($101, Data); ii:=inet_addr(pchar(ip)); pH:=gethostbyaddr(@ii,sizeof(ii),PF_INET); if (ph<>nil) then result:=pH.h_name else result:=''; WSACleanup;end;
function NetOnline : boolean;begin //---- 判断拨号网络是开还是关 if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then result := true; //-- 在线 else result := false; // 不在线end;
网络下载方面，也有个简单的办法，过几天有空了，我专门弄篇这样的文章上来
这里先提一下这种方法吧
uses UrlMon;
function DownloadFile(Source, Dest: string): Boolean; begin try Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0; except Result := False; end; end;
if DownloadFile('http://www.borland.com/delphi6.zip, 'c:\kylix.zip') then ShowMessage('Download succesful') else ShowMessage('Download unsuccesful') |
|
|