[Sample]示範用 WinSock 使用 HTTP 傳回網頁

[cying (魔笛好好聽唷~)]

下面的程式示範如何使用 WinSock 以及 HTTP 通訊協定來取得一網頁

內容。因為這個程式是用 TThread 寫成的，所以在取得網頁的過程中

不會讓前端的介面停住。

你可以在下面的網址取得此程式之所有檔案（必須用 Delphi 4 編譯）。

http://lsd.cc.ntu.edu.tw/upload/winsocksamp.zip  (4K)

重點部分code：
===================================================

  TClientThread = class(TThread)
  public
    Socket: TSocket;
    Cont: string;
    Url: string;
    Status: string;
  public
    constructor Create(Url: string);
    procedure ShowContent;
    procedure ShowError;
    procedure UpdateStatus;
    procedure Execute; override;
  end;

{ TClientThread }

procedure TClientThread.Execute;
const
  Port = 80;
var
  ServerName: string;
  Path: string;
  sa: TSockAddrIn;
  IP: Cardinal;
  entry: PHostEnt;
  Content: string;
  PP: Integer;
  Bytes: Integer;
  ContentLength: Integer;
  ContentType: string;
  procedure SendStr(S: string); // 送出字串
  begin
    if send(Socket, PChar(S)^, Length(S), 0) < Length(S) then
      Abort;
  end;
  function GetLine: string; // 取得一以 CR/LF 結束的行
  var
    C: Char;
  begin
    Result := '';
    while True do
    begin
      case recv(Socket, c, 1, 0) of
      0: Exit;
      SOCKET_ERROR: Abort;
      end;
      if c = ^M then // ^M 代表 CR (Carriage Return, 第13個ASCII字元)
        Continue;
      if c = ^J then // ^J 代表 LF (Line Feed, 第10個ASCII字元)
        Exit;
      Result := Result + c;
    end;
  end;
  procedure GetHeader; // 取得 HTTP 的 header information
                       // 此 header 內包含此文件的長度(ContentLength)
  var
    S: string;
    P: Integer;
    Left, Right: string;
  begin
    while True do
    begin
      S := GetLine;
      if S = '' then
        Exit;
      P := Pos(':', S);
      Left := LowerCase(Copy(S, 1, P - 1));
      Right := Copy(S, P + 2, Length(S));
      if Left = 'content-length' then
        ContentLength := StrToInt(Right)
      else if Left = 'content-type' then
        ContentType := Right;
    end;
  end;
  procedure ParseUrl;
  var
    I: Integer;
  begin
    if Copy(Url, 1, 7) <> 'http://' then
      Abort;
    Delete(Url, 1, 7);
    I := Pos('/', Url); // 尋找第一個 '/'
    if I = 0 then // 沒有 '/'，所以Server就是url了
    begin
      ServerName := Url;
      Path := '/';
    end
    else
    begin
      ServerName := Copy(Url, 1, I-1);
      Path := Copy(Url, I, Length(Url));
    end;
  end;
begin
  FreeOnTerminate := True; // 設定結束時釋放 Thread 占的空間
  try
    ParseUrl;
    Socket := WinSock.socket(AF_INET, SOCK_STREAM, 0); // 分配一個socket
    try
      FillChar(sa, SizeOf(sa), 0); // 將 TSockAddrIn 結構體清成zero
      sa.sin_family := AF_INET;    // 設定 family(固定為af_inet)
      sa.sin_port := htons(Port);  // 將port由host byte order轉成network byte order
      IP := inet_addr(PChar(ServerName)); // 試試看 ServerName 能不能直接轉成 IP
      if IP = INADDR_NONE then            // 如果不能的話則透過 DNS 查詢
      begin
        Status := '找尋主機中...';
        Synchronize(UpdateStatus);
        entry := gethostbyname(PChar(ServerName));
          // 查詢主機
        if entry = nil then // 若查不到則 Abort
          Abort;
        Move(entry^.h_addr^^, IP, SizeOf(IP)); // 取得 IP
      end;
      sa.sin_addr.s_addr := IP; // 將 IP 填入 TSockAddrIn 結構體
      Status := '主機找到，發出要求中...';
      Synchronize(UpdateStatus);
      if connect(Socket, sa, SizeOf(sa)) = SOCKET_ERROR then // 試試連結
        Abort; // 不能連結則 Abort
      // 下面送出 HTTP 的要求字串
      SendStr('GET ' + Path + ' HTTP/1.1'^M^J);
      SendStr('Accept: */*'^M^J);
      SendStr('User-Agent: My app'^M^J);
      SendStr(^M^J);
      Status := '取得文件中...';
      Synchronize(UpdateStatus);
      GetHeader; // 取得 HTTP 的 header information
        // 此 header 內包含此文件的長度(ContentLength)
      SetLength(Content, ContentLength); // 設定字串長度為 ContentLength
      PP := 1; // 設定『游標』位置。之所以需要游標位置是因為 WinSock 的 recv
               // 並非會等到所有資料傳完才返回，而是當其內部 buffer 滿的時候
               // 就返回，此時你必須記錄目前位置，以便下次繼續讀取
      while True do // 取得資料的主回圈
      begin
        // 取得資料，此函數傳回的值為：
        // 0: 代表資料擷取結束，或遠端主機正常結束
        // 大於 0：傳回資料 byte 數
        // SOCKET_ERROR：發生錯誤！
        Bytes := recv(Socket, Content[PP], ContentLength, 0);

        if Bytes = 0 then
          Break;
        if Bytes = SOCKET_ERROR then
          Abort;
        Inc(PP, Bytes); // 將『游標』前移
        if PP >= ContentLength then // 邊界狀況
          Break;
        Status := '取得文件中...%' + IntToStr(Round(PP / ContentLength * 100)) + '(' + IntToStr(PP) + '位元組已收到)';
        Synchronize(UpdateStatus);
      end;
      Cont := Content; // 網頁內容已經成功的傳回，存在 Content 變數中
      Synchronize(ShowContent); // show 出 content！
      Status := '完成...';
      Synchronize(UpdateStatus);
    finally
      closesocket(Socket);
    end;
  except
    on E: EAbort do
    begin
      Synchronize(ShowError);
      Status := '取消...';
      Synchronize(UpdateStatus);
    end;
  end;
end;

procedure TClientThread.ShowContent;
begin
  Form1.Memo1.Lines.Text := Cont;
end;

procedure TClientThread.ShowError;
begin
  Form1.Memo1.Lines.Text := '發生錯誤！'
end;

procedure TClientThread.UpdateStatus;
begin
  Form1.StatusBar1.SimpleText := Status;
end;

constructor TClientThread.Create(Url: string);
begin
  Self.Url := Url;
  inherited Create(False);
end;

--
Chaos is the best description of the constant state of human society.
Therefore, dynamic balance is required for us to to survive when vital fault
occurrs. So in the society, we don't chase for peace and order, but existence
and survival, instead.

--
※ 發信站: 批踢踢實業坊(ptt.twbbs.org) 
◆ From: T232-004.dialup