多线程ipman问题(50分)

主要思路是，在主线程首先开一个LISTEN的现成，当听到包后，从线程中发一个消息到
主线程，然后主线程再开一个线程进行监听。
但是，我发现丢包率好象更高，而且有一大堆的0，我的感觉好象是，DATA的指针乱了。



附上线程单元。
unit netthr;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, communit, netfun,nb30;

type
TMyArray=array[0..BUFFER_SIZE-1] of BYTE ;
TNetThread = class(TThread)
private
MainWnd:THandle;
HCloseEvent:THandle;
hVxD:THandle;
filter:WORD;
RecvTab:array [0..RECV_MAX-1] of PacketTable;
EventTab:array [0..RECV_MAX] of THandle;
InBuff:array [0..(sizeof(PACKET_OID_DATA) + 127)] of Byte;
m_EtherAddr:EtherAddr;
Buf:TMyArray;
size,port:integer;
pdataBYTEARRAY ;
protected
procedure Execute; override;
function RecvPacket(hEvent: THandle; pbuf: PByte;var getwant:boolean;i:integer;var flag:boolean): SmallInt;
procedure ResolvePacket(buffer:TMyArray;DataLen:integer);
procedure HandleMSG(msg:Tmsg);
function choicepacket(Seth:EtherAddr;Deth:EtherAddr):boolean;
function NBGetAdapterAddress:EtherAddr;
procedure getmsg;
procedure writefile;
// procedure SendEtherPacket(msg:Tmsg);
public
constructor Create(w:thandle);
procedure DoTerminate; override;
end;
TwriteThread=class(TThread)
private
start,port:integer;
pdata:TMyArray;
size:integer;
protected
procedure writefile;
procedure execute;override;
public
constructor create(porttype:integer;data:TMyArray;len:integer;starpos:integer);
end;
implementation

function TNetThread.choicepacket(Seth, Deth: EtherAddr): boolean;
var
i:integer;
begin
for i:=0 to 5 do
begin
if Seth.AddrByte<>Deth.AddrByte then
break;
end;
if i=6 then
result:=true
else
result:=false;
end;

constructor TNetThread.Create(w:thandle);
var
dwErrorCodeWORD;
i:integer;
hEvent:THandle;
ndisvaluechar;
begin
mainwnd:=w;
filter:=NDIS_PACKET_TYPE_PROMISCUOUS;
///* Open device */
hVxD := CreateFile('//./VPACKET.VXD',
GENERIC_READ or GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED or
FILE_FLAG_DELETE_ON_CLOSE,
0);

if (hVxD = INVALID_HANDLE_VALUE) then
begin
dwErrorCode := GetLastError();
if (dwErrorCode = ERROR_NOT_SUPPORTED) then
showmessage('Unable to open VxD,device does not support DeviceIOCTL')
else
showmessage('Unable to open VxD, Error code'+inttohex(dwErrorCode,4))
end;

///* Device opened successfully */
///* Bind driver to NDIS3 adapter */
ndisvalue:=getndis;
Bind(hVxd,ndisvalue);

///* Set Filter */
// if(GetHardEtherAddr(hVxD,@m_EtherAddr)<>OK) then exit;
m_EtherAddr:=NBGetAdapterAddress;
SetOid(hVxD, OID_GEN_CURRENT_PACKET_FILTER, 4, filter, InBuff);

for i:=0 to RECV_MAX-1 do
begin
hEvent := CreateEvent(nil, TRUE, false, nil);
if(hEvent=0) then
begin
showmessage('Can not create event');
exit;
end;

RecvTab.hEvent:=hEvent;
fillchar(RecvTab.Buffer,0,BUFFER_SIZE);
RecvTab.Size:=BUFFER_SIZE;
RecvTab.Active:=TRUE;
RecvTab.PackType:=FLAG_READ;
EventTab:=hEvent;
RecvStart(hVxD,@RecvTab);
end;
// MainWnd:=w;
HCloseEvent:=CreateEvent(nil,True,False,nil);
inherited Create(False);
postmessage(MainWnd,WM_Thread_Recv,Msg_Create,ThreadID);
end;

procedure TNetThread.DoTerminate;
begin
CloseHandle(HCloseEvent);
// postmessage(MainWnd,WM_Net_Msg,Msg_Close,ThreadID);
Terminate;
Destroy;
end;

procedure TNetThread.Execute;
begin
getmsg;
end;
procedure TNetThread.getmsg;
var
dwWait: THandle;
msg:TMsg;
i,len:integer;
getpacket,cont:boolean;
hEvent:THandle;
begin
cont:=true;
i:=WaitForMultipleObjects(RECV_MAX,@EventTab,FALSE,INFINITE);
len:=RecvPacket(hEvent,@buf,getpacket,i,cont);
if getpacket then
begin
ResolvePacket(buf,Len);
end;
if PeekMessage(msg,0,0,0,PM_REMOVE) then
begin
if msg.lParam=20 then
;
end;
end;

procedure TNetThread.HandleMSG(msg:Tmsg);
begin
{ case msg.message of
TM_Close: SetEvent(HCloseEvent);
TM_Send:
begin
if(SendPacket(hVxD,PByte(msg.wParam),msg.lParam)=SYSERR) then
showmessage('Can not send Ether packet.');
LocalFree(msg.wParam);
end;
end;}
end;

function TNetThread.NBGetAdapterAddress: EtherAddr;
Var
NCB : TNCB; // Netbios control block file://NetBios控制块
ADAPTER : TADAPTERSTATUS; // Netbios adapter status//取网卡状态
LANAENUM : TLANAENUM; // Netbios lana
intIdx : Integer; // Temporary work value//临时变量
cRC : Char; // Netbios return code//NetBios返回值
strTemp : String; // Temporary string//临时变量
i:integer;
Begin
// Initialize
fillchar(result,5,0);
Try
// Zero control blocl
ZeroMemory(@NCB, SizeOf(NCB));
// Issue enum command
NCB.ncb_command := Chr(NCBENUM);
cRC := NetBios(@NCB);
// Reissue enum command
NCB.ncb_buffer := @LANAENUM;
NCB.ncb_length := SizeOf(LANAENUM);
NCB.ncb_command := Chr(NCBENUM);
NetBios(@NCB);
for i:=0 to ord(lanaEnum.length)-1 do
begin
// Reset adapter
ZeroMemory(@NCB, SizeOf(NCB));
NCB.ncb_command := Chr(NCBRESET);
NCB.ncb_lana_num := LANAENUM.lana;
NetBios(@NCB);
// Get adapter address
ZeroMemory(@NCB, SizeOf(NCB));
NCB.ncb_command := Chr(NCBASTAT);
NCB.ncb_lana_num := LANAENUM.lana;
StrPCopy(NCB.ncb_callname, '*');
NCB.ncb_buffer := @ADAPTER;
NCB.ncb_length := SizeOf(ADAPTER);
NetBios(@NCB);

// Convert it to string
For intIdx := 0 To 5 Do
result.AddrByte[intIdx]:=byte(ADAPTER.adapter_address[intIdx]);

// strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]),2);
end;
Finally
End;
End;

function TNetThread.RecvPacket(hEvent: THandle; pbuf: PByte;var getwant:boolean;i:integer;var flag:boolean): SmallInt;
var
j,k:integer ;
pEtherHeadEtherPacketHead;
temp1word;
dwWait :integer;
begin
postmessage(MainWnd,WM_Thread_Create,1,100);
result:=SYSERR;
temp1:=0;
getwant:=false;
for j:=0 to RECV_MAX-1 do
if(EventTab=RecvTab[j].hEvent) then
break;
k:=j;
if((RecvTab[k].PackType=FLAG_READ) and (RecvTab[k].Active=TRUE)) then
begin
//* just read package about the ethe */
GetOverlappedResult(hVxD,RecvTab[k].Overlap,temp1,FALSE);
RecvTab[k].length:=temp1;
if(RecvTab[k].Length>BUFFER_SIZE) then
RecvTab[k].Length:=BUFFER_SIZE;
pEtherHead:=PEtherPacketHead(@RecvTab[k].Buffer);
//过滤包
if choicepacket(pEtherHead.DestEther, m_EtherAddr) or choicepacket(pEtherHead.SourEther, m_EtherAddr) then
begin
getwant:=true;
flag:=false;
end
else
begin
flag:=true;
end;
// pbuf:=PByte(LocalAlloc(LMEM_FIXED,MAX_PACKET_SIZE));
move(RecvTab[k].Buffer,pbuf^,temp1);
CloseHandle(RecvTab[k].hEvent);
for j:=i to RECV_MAX-2 do
begin
EventTab[j]:=EventTab[j+1];
end;
hEvent := CreateEvent(nil, TRUE, false, nil);
if(hEvent=0) then
begin
showmessage('Can not create event');
exit;
end;
RecvTab[k].hEvent:=hEvent;
fillchar(RecvTab[k].Buffer,0,BUFFER_SIZE);
RecvTab[k].Size:=BUFFER_SIZE;
RecvTab[k].Active:=TRUE;
RecvTab[k].PackType:=FLAG_READ;
EventTab[RECV_MAX-1]:=hEvent;
RecvStart(hVxD,@RecvTab[k]);
result:=RecvTab[k].length;
end
else
result:=SYSERR;
end;

{ TwriteThread }

constructor TwriteThread.create(porttype: integer;data:TMyArray;len:integer;starpos:integer);
var
tmp:tbytearray;
begin
start:=starpos;
size:=len;
pdata:=data;
port:=porttype;
inherited create(false);
end;

procedure TwriteThread.execute;
begin
Synchronize(writefile);
end;

procedure TwriteThread.writefile;
var
f:textfile;
i:integer;
temp:byte;
begin
case port of
0:
begin
assign(f,smtpfile);
if fileexists(smtpfile) then
append(f)
else
rewrite(f);
end;
1:
begin
assign(f,pop3file);
if fileexists(pop3file) then
append(f)
else
rewrite(f);
end;
2:
begin
assign(f,htmlfile);
if fileexists(htmlfile) then
append(f)
else
rewrite(f);
end;
3:
begin
assign(f,telnetfile);
if fileexists(telnetfile) then
append(f)
else
rewrite(f);
end;
else
;
end;
if(size>Max_Data_Len) then size:=Max_Data_Len;
for i:=start to size+start do
begin
temp:=pdata;
if (chr(temp)=#13) or (chr(temp)=#10) then
continue
else
if(temp<byte(' ')) then
write(f,inttostr(ord(temp)))
else write(f,chr(temp));
end;
close(f);
end;

procedure TNetThread.ResolvePacket(buffer:TMyArray;DataLen:integer);
var
pfout:textfile;
Continue,flag:boolean;
pEtherHeadEtherPacketHead ;
pIPHeadIPPacketHead ;
pTCPHeadTCPPacketHead ;
pARPHeadARPPacket ;
pICMPHeadICMPPacketHead ;
pUDPHeadUDPPacketHead ;
i,headlen,totallen:integer;
psourip,pdestipIPAddr ;
psoureth,pdestethEtherAddr ;
sourport,destport:WORD ;
seqno,acknoWORD ;
filename:string;
tmp:variant;
begin
if(DataLen=SYSERR) then
exit;
pEtherHead:=@Buffer;
case (swaps(pEtherHead.ServType)) of
ETHER_PROTO_IP: //* IP packet */
begin
pIPHead:=@(Buffer[ETHER_HEAD_LEN]);
headlen:=(pIPHead.VerHLen) and $f;
headlen:=headlen*4;
totallen:=swaps(pIPHead.TtlLen);
psourip:=@(pIPHead.SourIP);
pdestip:=@(pIPHead.DestIP);
flag:=TRUE;
if(flag) then
begin
case (pIPHead.Proto) of
IP_PROTO_TCP: //* TCP packet */
begin
pTCPHead:=@(Buffer[ETHER_HEAD_LEN+headlen]);
totallen:=totallen-headlen;
sourport:=swaps(pTCPHead.SourPort);
destport:=swaps(pTCPHead.DestPort);
seqno:=swapl(pTCPHead.SeqNo);
ackno:=swapl(pTCPHead.AckNo);
headlen:=(pTCPHead.HLen) shr 4;
headlen:=headlen*4;
totallen:=totallen-headlen;
size:=totallen;
pdata:=ptr(integer(pTCPHead)+headlen);
//* TODO */
flag:=TRUE;
if(flag) then
begin
if destport=25 then
begin
postmessage(MainWnd,WM_Thread_Getmail,1,100);
port:=0;
Synchronize(writefile);
end
else if sourport=110 then
begin
postmessage(MainWnd,WM_Thread_Getmail,1,100);
port:=1;
Synchronize(writefile);
end;
{else if destport=6666 then
begin
port:=2;
Synchronize(writefile);
end
else if destport=23 then
begin
port:=3;
Synchronize(writefile);
end;}

end;
end;
end;
end;
end;
end;

end;

procedure TNetThread.writefile;
var
f:textfile;
i:integer;
temp:byte;
begin
case port of
0:
begin
assign(f,smtpfile);
if fileexists(smtpfile) then
append(f)
else
rewrite(f);
end;
1:
begin
assign(f,pop3file);
if fileexists(pop3file) then
append(f)
else
rewrite(f);
end;
2:
begin
assign(f,htmlfile);
if fileexists(htmlfile) then
append(f)
else
rewrite(f);
end;
3:
begin
assign(f,telnetfile);
if fileexists(telnetfile) then
append(f)
else
rewrite(f);
end;
else
;
end;
if (size > Max_Data_Len) then size:=Max_Data_Len;
for i:=0 to size do
begin
temp:=pdata;
if (chr(temp)=#13) or (chr(temp)=#10) then
continue
else
if(temp<byte(' ')) then
write(f,inttostr(ord(temp)))
else write(f,chr(temp));
end;
close(f);
end;

end.

gutian:如果还想接着讨论请定期提前自己的帖子，如果不想继续讨论请结束帖子。

gutian:如果还想接着讨论请定期提前自己的帖子，如果不想继续讨论请结束帖子。

提问者:
如果你还要继续讨论请定期提前你的帖子，如果不想继续讨论请结束帖子。
请认真阅读大富翁论坛规则说明 http://www.delphibbs.com/delphibbs/rules.asp