用delphi实现自动NAT(3)

作者在 2007-08-07 02:46:00 发布以下内容
//
// 连接根设备...
procedure TForm1.Button2Click(Sender: TObject);
begin
   requested:=false;
   response:='';
   clientsocket.Host:=routerip;
   clientsocket.Port:=routerport;
   clientsocket.Active:=true;
   memo1.lines.add('向'+routerip+':'+inttostr(routerport)+'设备发起连接...');
   memo1.lines.add('');
end;

//
// 连接成功...
procedure TForm1.ClientSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
   memo1.lines.add('与'+routerip+':'+inttostr(routerport)+'设备成功连接');
   memo1.lines.add('');
end;

//
// 提交查询请求...
procedure TForm1.ClientSocketWrite(Sender: TObject; Socket: TCustomWinSocket);
var
   request: string;
begin
//
// 假如已经提交,则不再提交...
   if requested then
      exit;
//
// 得到请求串...
   request:='GET '+url+' HTTP/1.1'#13#10
           +'Host: '+routerip+':'+inttostr(routerport)+#13#10#13#10;
//
// 发送请求...
   memo1.lines.add('向'+routerip+':'+inttostr(routerport)+'提交如下查询请求:'#13#10+request);
   memo1.lines.add('');
   requested:=true;
   socket.SendBuf(request[1],length(request));
end;

//
// 得到应答数据时...
procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   tmpstr,tmp: string;
   j: integer;
begin
   j:=socket.ReceiveLength;
   setlength(tmpstr,j);
   socket.ReceiveBuf(tmpstr[1],j);
   response:=response+tmpstr;
//
// 若应答数据未全部得到,等待下个读事件...
   if not responsefinished(response) then
      exit;
//
// 关闭套接字...
   memo1.lines.add('从'+routerip+':'+inttostr(routerport)+'收到如下应答数据:'#13#10+response);
   memo1.lines.add('');
   socket.Close;
//
// 若已经全部得到,进行XML解析,定位到控制URL所在节...
   tmpstr:=response;
   controlurl:='';
   //
   // 得到基地址...
   j:=pos(uppercase('<URLBase>'),uppercase(tmpstr));
   if j<=0 then
      exit;
   delete(tmpstr,1,j+length('<URLBase>')-1);
   j:=pos(uppercase('</URLBase>'),uppercase(tmpstr));
   if j<=1 then
      begin
         urlbase:='http://'+routerip+':'+inttostr(routerport)+url;
         //
         tmp:=urlbase;
         urlbase:='';
         j:=pos('/',tmp);
         while j>0 do
            begin
               urlbase:=urlbase+copy(tmp,1,j);
               delete(tmp,1,j);
               j:=pos('/',tmp);
            end;
      end
   else
      urlbase:=copy(tmpstr,1,j-1);
   memo1.lines.add('得到基地址='+urlbase);
   memo1.lines.add('');
   //
   // 查找设备urn:schemas-upnp-org:device:InternetGatewayDevice:1的描述段...
   j:=pos(uppercase('<deviceType>urn:schemas-upnp-org:device:InternetGatewayDevice:1</deviceType>'),uppercase(tmpstr));
   if j<=0 th

QuickBurro开发手记 | 阅读 3728 次
文章评论,共0条
游客请输入验证码