为什么我写的读取网卡MAC的程序在win2000下有时会出错(有源码)?(100分)

P

paf

Unregistered / Unconfirmed
GUEST, unregistred user!
这个程序你可以当一般的UDP的聊天程序,也可以读取别人机子的用户、工作组、
用户说、网卡Mac等信息(其实没有进行处理,只是把内容接收而已)
接收的内容大概如下:
00 00 84 00 00 00 00 01 00 00 00 00 ; ?
20 43 4B 41 41 41 41 41 41 41 41 41 ; CKAAAAAAAAA
41 41 41 41 41 41 41 41 41 41 41 41 ; AAAAAAAAAAAA
41 41 41 41 41 41 41 41 41 00 00 21 ; AAAAAAAAA !
00 01 00 00 00 00 00 AD 07 4E 49 43 ; ?NIC
4B 20 20 20 20 20 20 20 20 20 20 20 ; K
00 04 00 42 4C 41 43 4B 20 54 45 41 ; BLACK TEA
4D 20 20 20 20 20 00 84 00 4E 49 43 ; M ?NIC
4B 20 20 20 20 20 20 20 20 20 20 20 ; K
03 04 00 4E 49 43 4B 20 20 20 20 20 ; NICK
20 20 20 20 20 20 20 04 00 42 4C 41 ; BLA
43 4B 20 54 45 41 4D 20 20 20 20 20 ; CK TEAM
1E 84 00 42 4C 41 43 4B 20 54 45 41 ; ?BLACK TEA
4D 20 20 20 20 20 1D 04 00 01 02 5F ; M _
5F 4D 53 42 52 4F 57 53 45 5F 5F 02 ; _MSBROWSE__
01 84 00 44 45 53 54 00 00 00 00 00 ; ?DEST
00 00 00 00 00 00 00 00 00 00 00 00 ;
00 00 00 00 00 00 00 00 00 00 00 00 ;
00 00 00 00 00 00 00 00 00 00 00 00 ;
00 00 00 00 00 00 00 00 00 00 00 00 ;
00 00 00 00 00 00 00 00 00 00 00 00 ;
00 00 00 00 00 00 00 00 00 00 00 00 ;
00 ;

我的问题是,在win2000下如下语句有时会使机子的内存用光(用鼠标移动标题时不能移动)!
在win98下没有这个问题,为什么会这样?

len := recvfrom(s, buffer, sizeof(buffer), 0, FSockAddrIn, flen);


======================================================================

unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, winsock, ComCtrls, shellapi;

const
WM_SOCK = WM_USER + 2; //自定义windows消息

type
TForm1 = class(TForm)
Memo1: TMemo; //显示内容
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Set_Bt: TButton; //端口IP邦定按钮
Send_BT: TButton; //发送按钮
Show16: TCheckBox; //是否显示十六进制数
SendCB: TComboBox; //要发送的字符串
Button1: TButton; //发送137数据
SB1: TStatusBar;
Button2: TButton; //新窗口
Addr1: TComboBox; //对方主机
ShowMyMsg: TCheckBox; //显示自己发送的信息
Button3: TButton; //清空
MyPort: TComboBox; //本机端口
Port1: TComboBox; //对方的端口
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Set_BtClick(Sender: TObject); //端口IP邦定
procedure Send_BTClick(Sender: TObject); //发送
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure SendCBKeyPress(Sender: TObject; var Key: Char);
procedure Show16Click(Sender: TObject);
private
s: TSocket;
Addr: TSockAddr;
FSockAddrIn: TSockAddrIn;
procedure ReadData(var Message: TMessage); message WM_SOCK;
procedure SendData(b: array of byte);
function ByteToHexChr(buffer: array of byte;Length:integer; CC: integer): string;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

//得到IP数组
function getIPs: TStrings;
type
TaPInAddr = array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
str: string;
begin
WSAStartup($101, GInitData);
Result := TStringList.Create;
Result.Clear;
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then Exit;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while pPtr^ <> nil do
begin
str := inet_ntoa(pptr^^);
if str <> '' then Result.Add(str);
Inc(I);
end;
WSACleanup;
end;


//==== 自动把ComboBox控件的内容里没有的内容加入列表中 =====!
procedure AddComboBox(CB: TcomboBox);
const TempMax = 20;
var
i, a: integer;
begin
if trim(cb.text) = '' then exit;
a := CB.Items.IndexOf(CB.Text);
if a > 0 then begin
cb.Items.Insert(0, CB.text);
cb.ItemIndex := 0;
cb.Items.Delete(a + 1);
end;

if a = -1 then begin
cb.Items.Insert(0, CB.text);
for i := cb.Items.Count - 1 downto tempMax do
begin
cb.Items.Delete(i);
end;
end;

end;

function AddrtoIP(addr: Dword): string;
begin
Result := format('%d.%d.%d.%d', [Lo(Loword(addr)), //最底位
Hi(Loword(addr)),
Lo(Hiword(addr)),
Hi(Hiword(addr))]); //最高位
end;


procedure GetMyIP;
begin
try
form1.Addr1.Items := getIPs; //得到IP
form1.Addr1.ItemIndex := form1.Addr1.Items.Count - 1;
except
form1.Addr1.Text := '出错了!';
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
TempWSAData: TWSAData;
thid: dword;
begin
if WSAStartup($101, TempWSAData) = 1 then showmessage('初始化出错!');


beginthread(nil, 0, @GetMyIP, nil, 0, thid); //线程



// Set_BtClick(Sender); //设置
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
CloseSocket(s); //关闭Socket
WSACleanUp; //关闭
end;

procedure TForm1.Set_BtClick(Sender: TObject);
begin
set_bt.tag := 1;
CloseSocket(s);
s := Socket(AF_INET, SOCK_DGRAM, 0);
if (s = INVALID_SOCKET) then //Socket创建失败
begin
SB1.Panels[0].text := 'UDP 设置...';

showmessage(inttostr(WSAGetLastError()) + ' Socket创建失败');
CloseSocket(s);
exit;
end;
//本机SockAddr绑定
addr.sin_family := AF_INET;
addr.sin_port := htons(strtoint(MyPort.text));
addr.sin_addr.S_addr := INADDR_ANY;
if bind(s, addr, sizeof(addr)) <> 0 then begin
showmessage('绑定失败');
exit;
end;

WSAAsyncSelect(s, self.Handle, WM_SOCK, FD_READ);

//对方SockAddrIn设定
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(strtoint(Port1.text));
fsockaddrin.sin_addr.S_addr := inet_addr(pchar(Addr1.text));

SB1.Panels[0].text := '完成 UDP 设置.';
end;

//读十六进制数

function TForm1.ByteToHexChr(buffer: array of byte;Length:integer; CC: integer): string;
var
MainStr, Hexstr, Str: string;
i,j: integer;
begin
for i := 0 to (Length - 1) do begin

Hexstr := Hexstr + format('%s ', [inttohex(buffer, 2)]);

case buffer of
0..31,127..128,245..255: Str := Str + ' ';
else str := Str + char(buffer);
end;
//----------------
j:=cc*2+cc;
if (((i + 1) mod CC) = 0) or (i = (Length - 1)) then begin
MainStr := MainStr + format('%-' + inttostr(j) + 's',[hexstr]) +'; ' + str + #13#10;
hexstr := '';
str := '';
end;
end;
result := Mainstr;
end;

procedure TForm1.ReadData(var Message: TMessage); //接收UDP数据
var
buffer: array[1..500] of byte;
Event: word;
i, len: integer;
flen: integer;
ip, value, str: string;
begin
SB1.Panels[0].text := '接收数据....';
str := '';
value := '';
Event := WSAGetSelectEvent(Message.LParam);
if Event <> FD_READ then exit;
len := recvfrom(s, buffer, sizeof(buffer), 0, FSockAddrIn, flen); //就是这一包在win2000下有时会出错!

if len = -1 then exit;
form1.caption := '接收到 ' + inttostr(len) + ' 个字节的数据!';
ip := AddrtoIP(fsockaddrin.sin_addr.S_addr);

if show16.Checked = false then begin //是否显示16进制数
// for i := 1 to len do value := value + format('%s ', [inttohex(buffer, 2)]);
// value := value + '= ';
for i := 1 to len do begin
case buffer of
0, 13: str := str + ' ';
else str := str + char(buffer);
end;
end;
Memo1.Lines.Add(format('%-15s: %s%s', [ip, value, str]));
end
else begin
memo1.lines.Add(ByteToHexChr(buffer,len,12));
end;


SB1.Panels[0].text := '数据接收完成.';
end;

procedure TForm1.SendData(b: array of byte);
var
len: integer;
Err: Integer;
begin
SB1.Panels[0].text := '发送数据....';
// FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(edit1.text));
len := sendto(s, b[0], sizeof(b), 0, FSockAddrIn, sizeof(FSockAddrIn));
//if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then showmessage(inttostr(WSAGetLastError()));
if len = SOCKET_ERROR then
showmessage('发送出错!');
if len <> sizeof(b) then
showmessage('内容没有发完!');
Err := WSAGetLastError();
SB1.Panels[0].text := '发送完成.';


end;


procedure TForm1.Send_BTClick(Sender: TObject);
var
buffer: array of byte;
i, L: integer;
temp: string;
begin
if set_bt.tag = 0 then Set_BtClick(Sender); //设置
AddComboBox(SendCB);
AddComboBox(Addr1);
temp := SendCB.text;
if ShowMyMsg.Checked then Memo1.Lines.Add(format('%-15s: %s', ['[ My ]', temp]));
L := length(temp);
setlength(buffer, L);
for i := 1 to L do
begin
buffer[i - 1] := byte(temp);
end;
SendData(buffer);
SendCB.SetFocus;
end;

procedure TForm1.Button1Click(Sender: TObject);
const NbtstatPacket: array[0..49] of byte
= ($0, $0, $0, $10, $0, $1,
$0, $0, $0, $0, $0, $0, $20, $43, $4B,
$41, $41, $41, $41, $41, $41, $41, $41,
$41, $41, $41, $41, $41, $41, $41, $41,
$41, $41, $41, $41, $41, $41, $41, $41,
$41, $41, $41, $41, $41, $41, $0, $0, $21, $0, $1);
begin
senddata(NbtstatPacket);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
shellexecute(self.handle, nil, pchar(application.exename), nil, nil, SW_Normal);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Memo1.Lines.Clear;
end;

procedure TForm1.SendCBKeyPress(Sender: TObject; var Key: Char);
begin
if key = chr(13) then begin
Send_BTClick(nil);
sendcb.SelectAll;
end;
end;

procedure TForm1.Show16Click(Sender: TObject);
begin
ShowMyMsg.Checked :=false;
end;

end.
 
只是读取某些IP主机MAC内容才会出现上面的问题!
 
flen:=sizeof(FSockAddrIn); //关键是这一句。
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(NBTPORT);
Event := WSAGetSelectEvent(Message.LParam);
if Event = FD_READ then
begin
len := recvfrom(s, buffer, sizeof(buffer), 0, FSockAddrIn, flen);
...
 
接受答案了.
 
顶部