دخول

sa7er100 · 23-09-2012, 06:57 PM

راجعت البحث اخي ! لو وجدت ما طرحت السؤال

لدي اكثر الاكواد تعمل بشكل جيد على دلفي 7 لكن عندما نقلت المشروع على xe2 واجهت مشاكل في بعض الاكواد

كود :
function GetHTML(const AURL: string): string;
 var
   sHead,sHost,sPage: string;
   x,xCnt,xCntTotal: integer;
   sock: TClientSocket;
   ws: TWinSocketStream;
   ss: TStringStream;
   buff: array[0..4095] of char;
 const
   CrLf = #13#10;
 begin
   Result := '';

   sHost := AURL;
   x := Pos('//',sHost) ;
   if x > 0 then
     System.Delete(sHost,1,x+1) ;
   x := Pos('/',sHost) ;
   if x > 0 then
   begin
     sPage := Copy(sHost,x,Length(sHost)) ;
     System.Delete(sHost,x,Length(sHost)) ;
   end
   else
   begin
     sPage := '/';
   end;
 
   sock := TClientSocket.Create(nil) ;
   try
     try
       sock.ClientType := ctBlocking;
       sock.Port := 80;
       sock.Host := sHost;
       sock.Open;

       // set timeout to 20 seconds
       ws := TWinSocketStream.Create(sock.Socket,20000) ;
       ss := TStringStream.Create('') ;
       try
         sHead := 'GET ' + sPage + ' HTTP/1.0 ' + CrLf + 'Host: ' + sHost + CrLf + CrLf;
         StrPCopy(buff,sHead) ;

         ws.Write(buff,Length(sHead) + 1) ;
         ws.Position := 0;

         FillChar(buff,SizeOf(buff),0) ;
         repeat
           xCnt := ws.Read(buff,SizeOf(buff)) ;
           xCntTotal := xCntTotal + xCnt;
           ss.Write(buff[0],xCnt) ;
         until xCnt = 0;

         Result := ss.DataString;
       finally
         ws.Free;
         ss.Free;
       end;
     except
   end;
   finally
     sock.Free;
   end;
 end;
procedure TForm1.Button1Click(Sender: TObject);
 var
   ip: string;
 begin
   with TStringlist.Create do
   try
     Text := GetHTML('http://automation.whatismyip.com/n09230945.asp') ;
     if Count > 0 then ip := Strings[Count - 1];
   finally
     Free;
   end;
   edit1.Text:= ip ;
 end;

دخول
اسم المستخدم/البريد الالكتروني :
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة