一个关于TClientSocket控件的问题,我用TClientSocket控件遍了一个从HTTP服务器上下载文件的程序，来看看，或许对你也有帮助？

Question

我用TClientSocket控件遍了一个从HTTP服务器上下载文件的程序，有一个Edit1控件用来输入url，Button1用来分析URL从URL中得到Host Port 和文件名并设置TClientSocket控件参数连接服务器，Button3向服务器发送下载文件的请求，Button2用来断开服务器，memo1用来显示信息。
代码如下：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls;type
  TForm1 = class(TForm)
    Edit1: TEdit;
    SaveDialog1: TSaveDialog;
    Button1: TButton;
    Button2: TButton;
    ClientSocket1: TClientSocket;
    Label1: TLabel;
    Button3: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  host:string;
  filename:string;
  rurl:string;
  port:integer;
  sport:string;
  sendtext:string;
  downfile:TFileStream;
  Total:integer;
implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);  //这个是用来分析url并设置TClientSocket控件参数连接服务器
var
downurl:string;
len:integer;
i:integer;
j:integer;
mhost:string;
getstr:string;
begin
memo1.Clear;
Total:=0;
downurl:=edit1.Text ;
len:=length(downurl);if ((downurl[1]='h')or (downurl[1]='H'))
 and((downurl[2]='t') or (downurl[2]='T'))
 and((downurl[3]='t') or (downurl[3]='T'))
 and((downurl[4]='p') or (downurl[4]='P'))
 and(downurl[5]=':' )and(downurl[6]='/')
 and(downurl[7]='/')then
          begin
           for i:=8 to len  do
            begin
             if downurl[i]='/'then
                break;
            end;
           end;
setlength(host,i-8);
for j:=8 to i-1 do
   begin
   host[j-7]:=downurl[j];
   end;setlength(rurl,len-i+1);
for j:=i to len do
   begin
   rurl[j-i+1]:=downurl[j];
   end;for i:=len downto 8  do
    begin
      if downurl[i]='/'then
      break;
    end;
setlength(filename,len-i);
for j:= i+1 to len  do
    begin
    filename[j-i]:=downurl[j];
    end;for i:=1 to length(host) do
   begin   if host[i]=':'then
    break;
   end;if i=length(host)+1 then
 begin
  port:=80; end
else
  begin
  setlength(sport,length(host)-i);  for j:=i+1 to length(host) do
   begin
    sport[j-i]:=host[j];
    end;
  setlength(mhost,i-1);
  for j:=1 to i-1 do
   begin
   mhost[j]:=host[j];
   end;  port:=strtoint(sport);
  host:=mhost;
  end;getstr:=host+#13#10+inttostr(port)+#13#10+rurl+#13#10+filename;
ClientSocket1.Host:=host;
ClientSocket1.Port:=port;
if ClientSocket1.Active=false then
ClientSocket1.Active :=true;
end;procedure TForm1.Button3Click(Sender: TObject);//向服务器发送下载文件的请求
var
buf:array of byte;
len:integer;
begin
downfile:=TFileStream.Create(filename,fmCreate or fmShareExclusive);
sendtext:='GET '+rurl+' HTTP/1.1'+#13#10
        +'Accept:*/*'+ #13#10
        +'Accept-Language:zh-cn'+#13#10
        +'Accept-Encoding:gzip,deflate'+#13#10
        +'User-Agent:downsoft 1.0'+#13#10
        +'Host:'+host+#13#10
        +'Connection:close'+#13#10
        //+'Connection:Keep-Alive'+#13#10
        +#13#10;
len:=length(sendtext);
memo1.Lines.Add(sendtext);
ClientSocket1.Socket.SendText(sendtext);
end;procedure TForm1.Button2Click(Sender: TObject);//断开服务器
begin
ClientSocket1.Close;end;procedure TForm1.ClientSocket1Read(Sender: TObject;//服务器读取信息并保存到文件，这段程序不完整
  Socket: TCustomWinSocket);
var
buf:array[0..10000] of byte;
len:integer;
beginlen:=socket.ReceiveLength;
Total:=Total+len;
Label1.Caption:=inttostr(Total);
//memo1.lines.Add(inttostr(len));
socket.ReceiveBuf(buf,len);
downfile.Write(buf,len);
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.Lines.Add('Connect ok');
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
ClientSocket1.Close;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.Clear;
end;procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.Lines.Add('Disconnect ok');
downfile.Free;end;end.
我的问题是，我向服务器发送下载文件的请求，并且得到了正确恢复，开始发送文件数据，但我从服务器得到文件数据总是和要下载的原文件不一样。总是少一点数据，而且无论文件大小得到文件数据总是和要下载的原文件数据在最后少一点，这是为什么，请帮帮我。

Answer 1

我这儿有个控件，实现相同功能、不过实现方法不一样，你参考一下：
==========================================================
unit HTTPGet;interfaceuses
  Windows, Messages, SysUtils, Classes, WinInet;type
  TOnProgressEvent = procedure(Sender: TObject; TotalSize, Readed: Integer) of object;
  TOnDoneFileEvent = procedure(Sender: TObject; FileName: String; FileSize: Integer) of object;
  TOnDoneStringEvent = procedure(Sender: TObject; Result: String) of object;  THTTPGetThread = class(TThread)
  private
    FTAcceptTypes,
    FTAgent,
    FTURL,
    FTFileName,
    FTStringResult,
    FTUserName,
    FTPassword,
    FTPostQuery,
    FTReferer: String;
    FTBinaryData,
    FTUseCache: Boolean;    FTResult: Boolean;
    FTFileSize: Integer;
    FTToFile: Boolean;    BytesToRead, BytesReaded: DWord;    FTProgress: TOnProgressEvent;    procedure UpdateProgress;
  protected
    procedure Execute; override;
  public
    constructor Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword, aPostQuery, aReferer: String;
                       aBinaryData, aUseCache: Boolean; aProgress: TOnProgressEvent; aToFile: Boolean);
  end;  THTTPGet = class(TComponent)
  private
    FAcceptTypes: String;
    FAgent: String;
    FBinaryData: Boolean;
    FURL: String;
    FUseCache: Boolean;
    FFileName: String;
    FUserName: String;
    FPassword: String;
    FPostQuery: String;
    FReferer: String;
    FWaitThread: Boolean;    FThread: THTTPGetThread;
    FError: TNotifyEvent;
    FResult: Boolean;    FProgress: TOnProgressEvent;
    FDoneFile: TOnDoneFileEvent;
    FDoneString: TOnDoneStringEvent;    procedure ThreadDone(Sender: TObject);
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;    procedure GetFile;
    procedure GetString;
    procedure Abort;
  published
    property AcceptTypes: String read FAcceptTypes write FAcceptTypes;
    property Agent: String read FAgent write FAgent;
    property BinaryData: Boolean read FBinaryData write FBinaryData;
    property URL: String read FURL write FURL;
    property UseCache: Boolean read FUseCache write FUseCache;
    property FileName: String read FFileName write FFileName;
    property UserName: String read FUserName write FUserName;
    property Password: String read FPassword write FPassword;
    property PostQuery: String read FPostQuery write FPostQuery;
    property Referer: String read FReferer write FReferer;
    property WaitThread: Boolean read FWaitThread write FWaitThread;    property OnProgress: TOnProgressEvent read FProgress write FProgress;
    property OnDoneFile: TOnDoneFileEvent read FDoneFile write FDoneFile;
    property OnDoneString: TOnDoneStringEvent read FDoneString write FDoneString;
    property OnError: TNotifyEvent read FError write FError;
  end;procedure Register;implementation//  THTTPGetThreadconstructor THTTPGetThread.Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword, aPostQuery, aReferer: String;
                                  aBinaryData, aUseCache: Boolean; aProgress: TOnProgressEvent; aToFile: Boolean);
begin
  FreeOnTerminate := True;
  inherited Create(True);  FTAcceptTypes := aAcceptTypes;
  FTAgent := aAgent;
  FTURL := aURL;
  FTFileName := aFileName;
  FTUserName := aUserName;
  FTPassword := aPassword;
  FTPostQuery := aPostQuery;
  FTReferer := aReferer;
  FTProgress := aProgress;
  FTBinaryData := aBinaryData;
  FTUseCache := aUseCache;  FTToFile := aToFile;
  Resume;
end;procedure THTTPGetThread.UpdateProgress;
begin
  FTProgress(Self, FTFileSize, BytesReaded);
end;procedure THTTPGetThread.Execute;
var
  hSession, hConnect, hRequest: hInternet;
  HostName, FileName: String;
  f: File;
  Buf: Pointer;
  dwBufLen, dwIndex: DWord;
  Data: Array[0..$400] of Char;
  TempStr: String;
  RequestMethod: PChar;
  InternetFlag: DWord;
  AcceptType: LPStr;  procedure ParseURL(URL: String; var HostName, FileName: String);    procedure ReplaceChar(c1, c2: Char; var St: String);
    var
      p: Integer;
    begin
      while True do
       begin
        p := Pos(c1, St);
        if p = 0 then Break
        else St[p] := c2;
       end;
    end;  var
    i: Integer;
  begin
    if Pos('http://', LowerCase(URL)) <> 0 then
      System.Delete(URL, 1, 7);    i := Pos('/', URL);
    HostName := Copy(URL, 1, i);
    FileName := Copy(URL, i, Length(URL) - i + 1);    if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
      SetLength(HostName, Length(HostName) - 1);
  end;

Answer 2

procedure CloseHandles;
 begin
   InternetCloseHandle(hRequest);
   InternetCloseHandle(hConnect);
   InternetCloseHandle(hSession);
 end;begin
  try
    ParseURL(FTURL, HostName, FileName);    if Terminated then
     begin
      FTResult := False;
      Exit;
     end;    if FTAgent <> '' then
     hSession := InternetOpen(PChar(FTAgent),
       INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)
    else
     hSession := InternetOpen(nil,
       INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);    hConnect := InternetConnect(hSession, PChar(HostName),
      INTERNET_DEFAULT_HTTP_PORT, PChar(FTUserName), PChar(FTPassword), INTERNET_SERVICE_HTTP, 0, 0);    if FTPostQuery = '' then RequestMethod := 'GET'
    else RequestMethod := 'POST';    if FTUseCache then InternetFlag := 0
    else InternetFlag := INTERNET_FLAG_RELOAD;    AcceptType := PChar('Accept: ' + FTAcceptTypes);
    hRequest := HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.0',
                PChar(FTReferer), @AcceptType, InternetFlag, 0);    if FTPostQuery = '' then
     HttpSendRequest(hRequest, nil, 0, nil, 0)
    else
     HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
                     PChar(FTPostQuery), Length(FTPostQuery));    if Terminated then
     begin
      CloseHandles;
      FTResult := False;
      Exit;
     end;    dwIndex  := 0;
    dwBufLen := 1024;
    GetMem(Buf, dwBufLen);    FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,
                              Buf, dwBufLen, dwIndex);    if Terminated then
     begin
      FreeMem(Buf);
      CloseHandles;     
      FTResult := False;
      Exit;
     end;    if FTResult or not FTBinaryData then
     begin
      if FTResult then
        FTFileSize := StrToInt(StrPas(Buf));      BytesReaded := 0;      if FTToFile then
       begin
        AssignFile(f, FTFileName);
        Rewrite(f, 1);
       end
      else FTStringResult := '';      while True do
       begin
        if Terminated then
         begin
          if FTToFile then CloseFile(f);
          FreeMem(Buf);
          CloseHandles;          FTResult := False;
          Exit;
         end;        if not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then Break
        else
         if BytesToRead = 0 then Break
         else
          begin
           if FTToFile then
            BlockWrite(f, Data, BytesToRead)
           else
            begin
             TempStr := Data;
             SetLength(TempStr, BytesToRead);
             FTStringResult := FTStringResult + TempStr;
            end;           inc(BytesReaded, BytesToRead);
           if Assigned(FTProgress) then
            Synchronize(UpdateProgress);
          end;
       end;      if FTToFile then
        FTResult := FTFileSize = Integer(BytesReaded)
      else
       begin
        SetLength(FTStringResult, BytesReaded);
        FTResult := BytesReaded <> 0;
       end;      if FTToFile then CloseFile(f);       
     end;    FreeMem(Buf);    CloseHandles;
  except
  end;
end;// HTTPGetconstructor THTTPGet.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FAcceptTypes := '*/*';
  FAgent := 'UtilMind HTTPGet';
end;destructor THTTPGet.Destroy;
begin
  Abort;
  inherited Destroy;
end;procedure THTTPGet.GetFile;
var
  Msg: TMsg;
begin
  if not Assigned(FThread) then
   begin
    FThread := THTTPGetThread.Create(FAcceptTypes, FAgent, FURL, FFileName, FUserName, FPassword, FPostQuery, FReferer,
                                     FBinaryData, FUseCache, FProgress, True);
    FThread.OnTerminate := ThreadDone;
    if FWaitThread then
    while Assigned(FThread) do
     while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
   end
end;procedure THTTPGet.GetString;
var
  Msg: TMsg;
begin
  if not Assigned(FThread) then
   begin
    FThread := THTTPGetThread.Create(FAcceptTypes, FAgent, FURL, FFileName, FUserName, FPassword, FPostQuery, FReferer,
                                     FBinaryData, FUseCache, FProgress, False);
    FThread.OnTerminate := ThreadDone;
    if FWaitThread then
     while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
   end
end;procedure THTTPGet.Abort;
begin
  if Assigned(FThread) then
   begin
    FThread.Terminate;
    FThread.FTResult := False;
   end;
end;procedure THTTPGet.ThreadDone(Sender: TObject);
begin
  FResult := FThread.FTResult;
  if FResult then
   if FThread.FTToFile then
    if Assigned(FDoneFile) then FDoneFile(Self, FThread.FTFileName, FThread.FTFileSize) else
   else
    if Assigned(FDoneString) then FDoneString(Self, FThread.FTStringResult) else   
  else
   if Assigned(FError) then FError(Self);
  FThread := nil;
end;procedure Register;
begin
  RegisterComponents('UtilMind', [THTTPGet]);
end;end.

Answer 3

这个控件用的是wininet的HttpAPI,和我的程序实现的方法不同
我想知道为什么我从服务器得到文件数据总是和要下载的原文件不一样。总是少一点数据

Answer 4

luo521(rain) 我看了一下呵呵得到的文件不是少了而是变大了..
你把服务器返回的信息头也存进了文件.采用GET URL HTTP/1.1 方式的命令，WEB服务器是会返回一个信息头的。
处理办法
1，采用GET URL 方式命令，它不会返回信息头，但不见得所有WEB服务器支持这种命令，不推荐。
2，信息头是两个回车（也许是换行）结尾的，你接收的时候处理一下就是了。

Answer 5

[email protected]
thank you!************
* 努力学习 *
*   全为   *
*￥人民币￥*
************

Answer 6

[email protected]
THANK YOU!

Answer 7

实在太感谢了！
[email protected]

Answer 8

[email protected]谢谢！！！！！

Answer 9

还有没有呀，我也想要！
[email protected]