这些天为什么提问的人越来越少了呀,我来问,分不多了大家帮忙

[catac]

这些天为什么提问的人越来越少了呀,我来问你说,在网上发消息时,如果对方有防火墙,这个消息就会发不出去而且会有很大的延时,能不能发送的时候规定个时间,如果发不出去就放弃呀,

[honkily]

"发送的时候规定个时间，发不出去就放弃"什么意思？

[myadvice]

兄弟你所说的发消息是指的QQ上的发消息还是指的其它

如果是QQ上的话，到一定的时候他自动会问你：网络不通是否需要重发

通过防火墙只会影响传文件而对发消息影响不是太大

[catac]

是这个,怪我没说情楚,是信使服务
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,winsock;
function SendMsg(Toh,From,Msg:string):integer;
function ToUnicode(str:string;dest:PWideChar):integer;
function NetMessageBufferSend(servername:PWideChar;
MsgName:PWideChar;
FromName:PWideChar;
Buf: PWideChar;
var BufLen:integer):integer;cdecl;
type
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte;
TOS: Byte;
Flags: Byte;
OptionsSize: Byte;
OptionsData: PChar;
end;
PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = packed record
Address: DWORD;
Status: DWORD;
RTT: DWORD;
DataSize: Word;
Reserved: Word;
Data: Pointer;
Options: TIPOptionInformation ;
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;

msgthread = class(TThread)
private { Private declarations }
hICMP: THANDLE;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
protected
procedure Execute; override;
public
constructor create();
end;

implementation
uses unit1;
var aaa: array [0..7] of integer;

function ToUnicode(str:string;dest:PWideChar):integer;
var len:integer;
begin StringToWideChar(str,dest,len); Result:=len;end;

function NetMessageBufferSend; external 'netapi32.dll' name 'NetMessageBufferSend';

function ipa(ip:string;ms:string):integer;
var ii:integer;
begin
ip:=ip+'.';
//while strtoint(copy(ms,1,1))<>0 do
//begin

//ip:=copy(ip,pos('.',ip)+1,length(ip));
//ms:=copy(ms,5,length(ms));
//end;
ii:=0;
while length(ip)>0 do
begin
if strtoint(copy(ms,1,1))<>0 then aaa[ii+3]:=0 else aaa[ii+4]:=strtoint(copy(ip,1,pos('.',ip)-1));
aaa[ii]:=strtoint(copy(ip,1,pos('.',ip)-1));
ip:=copy(ip,pos('.',ip)+1,length(ip));
ms:=copy(ms,pos('.',ms)+1,length(ms));
ii:=ii+1;
end;
result:=ii;
end;

function SendMsg(Toh,From,Msg:string):integer;
var
ToName :array [0..64] of WideChar;
FromName :array [0..64] of WideChar;
WMsgText:array [0..1000] of WideChar;
MsgLen, i:integer;
begin
for i := 0 to 64 do ToName[i] := #0;
ToUnicode(Toh,ToName);
for i := 0 to 64 do FromName[i] := #0;
ToUnicode(From,FromName);
for i := 0 to 1000 do WMsgText[i] := #0;
ToUnicode(Msg,WMsgText);
Result:=NetMessageBufferSend(nil,ToName,FromName,@WMsgText,MsgLen);
end;

constructor msgthread.create ;
var
WSAData: TWSAData;
hICMPdll: HMODULE;
begin
hICMPdll := LoadLibrary('icmp.dll'); // Load the icmp.dll stuff 　　　　
@ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
hICMP := IcmpCreateFile;
inherited create(false);
end;

procedure msgthread.Execute;
var
strUser : PChar;
strSize : DWord;
UserName : string;
MessageHeader : TStringList;
ip:string; k,j,n,i,l,m:integer;
IPOpt:TIPOptionInformation;// IP Options for packet to send 　　
FIPAddress:DWORD;
pReqData,pRevData:PChar;
pIPE:PIcmpEchoReply;// ICMP Echo reply buffer 　　
FSize: DWORD;
MyString:string;
FTimeOut:DWORD;
BufferSize:DWORD;
begin
i:=ipa(form1.edit1.text,form1.edit2.text);
i:=aaa[5];
repeat
begin
l:=aaa[6];
m:=i;
repeat
begin
k:=aaa[7];
n:=l;
while k<254 do
begin
j:=k;
if not terminated then
begin
strUser := StrAlloc(100);
strSize := 100;
GetUserName(strUser,strSize);
UserName := strUser;
StrDispose(strUser);
MessageHeader := TStringList.Create;
MessageHeader.Add('---------------------------------');
MessageHeader.Add(' From you firends'{+UserName});
MessageHeader.Add('---------------------------------');
if i=0 then form1.edit1.text:=inttostr(aaa[0])+'.'+inttostr(aaa[1])+'.'+inttostr(l)+'.'+inttostr(k)
else if l=0 then form1.edit1.text:=inttostr(aaa[0])+'.'+inttostr(aaa[1])+'.'+inttostr(aaa[2])+'.'+inttostr(k)
else form1.edit1.text:=copy(form1.edit1.text,1,pos('.',form1.edit1.text)-1)+inttostr(i)+'.'+inttostr(l)+'.'+inttostr(k);
FIPAddress := inet_addr(PChar(form1.edit1.Text));
FSize := 40;
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);
FillChar(pIPE^, SizeOf(pIPE^), 0);
pIPE^.Data := pRevData;
MyString := 'Hello,World';
pReqData := PChar(MyString);
FillChar(IPOpt, Sizeof(IPOpt), 0);
IPOpt.TTL := 64;
FTimeOut := 100;
if IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString), @IPOpt, pIPE, BufferSize, FTimeOut)<>0
then begin SendMsg(form1.Edit1.text,'1.1.1.1',MessageHeader.Text+form1.Memo1.Text); form1.label2.caption:='OK'; k:=j+1; end;
FreeMem(pRevData);
form1.label2.caption:='';
end; k:=j+1;
end;
l:=n+1;
end;
until (l>255) and (i=0);
i:=m+1;
end;until (i>255) and (i=0);
end;
end.