求 《windows 网络编程之delphi篇》的原代码 重谢(0分)

  • 主题发起人 主题发起人 netgui
  • 开始时间 开始时间
N

netgui

Unregistered / Unconfirmed
GUEST, unregistred user!
本人急需〈〈windows 网络编程之delphi篇》的原代码
有的朋友能用qq发给我吗?
非常感激!
 
全都要?
 
ycherry
全部有更好啦 如果你有方便的话 用qq发给我好吗?
我的qq 49328726
要不,你把实例3 网卡物理地址 的那个发到我油箱
zhonggui001@163.net
真的非常谢谢你!
 
给我一份
qq:66095167
 
只是要获得 MAC 吗?我这有个方法:

function GetMAC_NB: String;
var
NCB: TNCB;
Adapter: TADAPTERSTATUS;
Lanaenum: TLanaEnum;
I: Integer;
re: Char;
buf: String;
begin
// Reset adapter
ZeroMemory(@NCB, SizeOf(NCB));
NCB.ncb_command := Chr(NCBRESET);
NCB.ncb_lana_num := Lanaenum.lana[0]; // important
re := NetBios(@NCB);
if Ord(re) <> 0 then Exit;

// Get adapter address
ZeroMemory(@NCB, SizeOf(NCB));
NCB.ncb_command := Chr(NCBASTAT);
NCB.ncb_lana_num := Lanaenum.lana[0];
StrPCopy(NCB.ncb_callname, '*');
NCB.ncb_buffer := @Adapter;
NCB.ncb_length := SizeOf(Adapter);
re := NetBios(@NCB);
if Ord(re) <> 0 then Exit;

buf := '';
for I := 0 to 5 do
buf := buf + IntToHex(Integer(Adapter.adapter_address), 2) + '-';
Result := Copy(buf, 0, Length(buf) - 1);
end;
 
ster>>>>>:
这个方法我知道
只是我出现了一些问题 内存访问错误 我没办法解决
希望能得到源代码!
 
简单:
1、win98下通过GUID
function TForm1.SysGetNicAddress:string;
var
Tmp:TGUID;
tmpstr,newstr:string;
cnt:Integer;
begin
try
CoCreateGuid(Tmp);
tmpstr:=GUIDToString(Tmp);
tmpstr:=Copy(tmpstr,Length(tmpstr)-12,12);
for cnt:=1 to 5 do
newstr :=newstr+Copy(tmpstr,cnt*2 -1 ,2)+'-' ;
newstr :=newstr+Copy(tmpstr,11,2);
except
newstr:='';
end;
Result :=newstr;
end;

2、win2000、XP下通过UDP协议
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, winsock,
StdCtrls;
const
WM_SOCK = WM_USER + 1; //自定义windows消息
UDPPORT = 6767; //设定UDP端口号
NBTPORT = 137;
...
procedure TForm1.FormCreate(Sender: TObject);
var
TempWSAData: TWSAData;
//optval: integer;
begin
// 初始化SOCKET
if WSAStartup($101, TempWSAData)=1 then
showmessage('StartUp Error!');

s := Socket(AF_INET, SOCK_DGRAM, 0);
if (s = INVALID_SOCKET) then //Socket创建失败
begin
showmessage(inttostr(WSAGetLastError())+' Socket创建失败');
CloseSocket(s);
end;
//本机SockAddr绑定
addr.sin_family := AF_INET;
addr.sin_addr.S_addr := INADDR_ANY;
addr.sin_port := htons(UDPPORT);
if Bind(s, addr, sizeof(addr)) <> 0 then
begin
showmessage('bind fail');
end;
WSAAsyncSelect(s, Form1.Handle , WM_SOCK, FD_READ);
//对方SockAddrIn设定
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(NBTPORT);
end;
procedure TForm1.GetInfo(buffer: Array of byte;len:integer);
var
str:string;
i,j,pos,name_num: integer;
begin

name_num:=0;
for i:=1 to len do
begin
if((buffer=$21)and(buffer[i+1]=$00)and(buffer[i+2]=$01))
then
begin
name_num:=buffer[i+9];
break;
end;
end;
if name_num=0 then exit;
pos:=i+10;

str:='';
{
for i:=pos to (pos+18*name_num-1) do
begin
if (((i-pos)mod 18) =0) then
begin
for j:=0 to 14 do
begin
if trim(char(buffer[i+j]))='' then buffer[i+j]:=ord(' ');
str:=str+char(buffer[i+j]);
end;
if (buffer[i+16] and $80)=$80 then
begin
str:=str+format('<%x>',[buffer[i+15]]);
str:=str+'<GROUP>';
ListBox1.Items.Add(str);
end
else
begin
str:=str+format('<%x>',[buffer[i+15]]);
str:=str+'<UNIQUE>';
ListBox1.Items.Add(str);
end;
str:='';
end;
end;
}
for i:=0 to 5 do
begin
str:=str+format('%.2x.',[buffer[i+pos+18*name_num]]);
end;
delete(str,length(str),1);
str:='MAC:'+str;
ListBox1.Items.Add(str);
ListBox1.Items.Add('------------------------------------------------------');
ListBox1.TopIndex :=ListBox1.Items.count-1;

end;
procedure TForm1.ReadData(var Message: TMessage);
var
buffer: Array [1..500] of byte;
len{,i}: integer;
flen: integer;
Event: word;
value: string;

begin
value:='';
flen:=sizeof(FSockAddrIn);
FSockAddrIn.SIn_Port := htons(NBTPORT);
Event := WSAGetSelectEvent(Message.LParam);
if Event = FD_READ then
begin
len := recvfrom(s, buffer, sizeof(buffer), 0, FSockAddrIn, flen);
{for i:=1 to len do value:=value+format('%x',[buffer]);
ListBox1.items.add(value);
value:='';
for i:=1 to len do if char(buffer)<>#0 then value:=value+char(buffer);
ListBox1.items.add(value);}
if len<> 0 then GetInfo(buffer,len);
end;
end;

procedure TForm1.SendData(b:array of byte);
var
len: integer;
begin

FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(edit1.text));
len := sendto(s, b[0],50, 0, FSockAddrIn, sizeof(FSockAddrIn));
//if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then showmessage(inttostr(WSAGetLastError()));
if len = SOCKET_ERROR then
showmessage('send fail');
if len <> 50 then
showmessage('Not Send all');
end;
3、win2000,XP还可以采用ARP
function inet_addr(const cp: PChar): DWord; stdcall; external 'WS2_32.DLL' name 'inet_addr';
function SendARP(const DestIP: DWord;
const SrcIP: DWord;
const pMacAddr: Pointer;
const PhyAddrLen: PULONG): DWord; stdcall; external 'IPHLPAPI.dll' name 'SendARP';

{$R *.dfm}
function TForm1.GetMacByIP(FIPAddr: string): string;
var
dwResult: DWord;
ulIPAddr: DWord;
ulMacAddr: array[0..5] of Byte;
ulAddrLen: ULONG;
begin
ulIPAddr := INet_Addr(PChar(FIPAddr));

if ulIPAddr = INADDR_NONE then
exit;
ulAddrLen := 6;
dwResult := SendARP(ulIPAddr, 0, @ulMacAddr, @ulAddrLen);

if dwResult = 0 then
result := (IntToHex(ulMacAddr[0], 2) + ':' +
IntToHex(ulMacAddr[1], 2) + ':' +
IntToHex(ulMacAddr[2], 2) + ':' +
IntToHex(ulMacAddr[3], 2) + ':' +
IntToHex(ulMacAddr[4], 2) + ':' +
IntToHex(ulMacAddr[5], 2))
else
result := '';
end;
不要用什么TNCB,这个需要引用nb30单元,这就要求系统必须安装netbios,这个已经很古老了,很多系统都不支持!!!!!
 
谢谢masm!我正不知道为何GUID的方法不管用,可能是因为我用的 Win2K 吧。
 
好像这个也行,用 IP Help API 中的 SendARP:

function SendARP(IP: DWord;
unknown: DWord;
pMacAddr: Pointer;
pMacLen: Pointer) : DWord; stdcall;

uses winsock;

function SendARP; external 'IpHlpApi.dll' name 'SendARP';

function GetMAC_SendARP(AIP: string): string;
var
ip: DWord;
mac: array[0..5] of byte;
maclen: Integer;
errcode: Integer;
begin
ip := inet_addr(PChar(AIP));
maclen := Length(mac);
errcode := SendArp(ip, 0, @MAC, @maclen);
Result := Format('%2X:%2X:%2X:%2X:%2X:%2X',
[mac[0], mac[1], mac[2], mac[3], mac[4], mac[5]]);
end;
 
后退
顶部