u_web_update.pas

以前写的一个利用P2P 技术的一个通讯的例子。里面用到了 DBISAM 、INDY 控件。

unit U_WEB_UPDATE;

interface

uses
   filectrl, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, ExtCtrls, StdCtrls, Gauges, Buttons, inifiles, shellapi, db,
   ImgList, ComCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
   IdTCPClient, IdHTTP, RzLabel, ScktComp;

type
   Tbuf_char = array[0..4095] of char;
   Tbuf_byte = array[0..4095] of byte;

type
   TF_WEB_UPDATE = class(TForm)
      Image1: TImage;
      Notebook_step: TNotebook;
      Label1: TLabel;
      ListBox_servers: TListBox;
      GroupBox1: TGroupBox;
      Label2: TLabel;
      Edt_url: TEdit;
      Label3: TLabel;
      Gauge_process: TGauge;
      btn_pre: TButton;
      btn_next: TButton;
      ListView_files: TListView;
      ImageList: TImageList;
      HTTPFiles: TIdHTTP;
      //HTTPFiles: TNMHTTP;
      //IdHTTP1: TIdHTTP;
      Label4: TLabel;
      Memo1: TMemo;
      Button1: TButton;
      Button2: TButton;
      procedure FormCreate(Sender: TObject);
      procedure btn_nextClick(Sender: TObject);
      procedure Notebook_stepPageChanged(Sender: TObject);
      procedure btn_preClick(Sender: TObject);
      procedure ListBox_serversClick(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
      procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
      procedure Button1Click(Sender: TObject);
      procedure Button2Click(Sender: TObject);
      procedure FormActivate(Sender: TObject);

   private
      g_path: string;
      sys_id: string;
      AppIni: TIniFile;
      files: TStringList;
      function ExistNewFile: Boolean;
   public
      { Public declarations }
      ClientSocket1: TClientSocket;
      filename1: string; //本地文件名
      serfilename: string; //服务器端文件名
      serhost1: string; //服务器地址
      can_rec1: boolean; //是否可以接收
      stop1: boolean; //是否停止
      sj: boolean; //是否所有文件均下载成功
   end;

var
   F_WEB_UPDATE: TF_WEB_UPDATE;

implementation
var
   pos1: longint; //上次下载到的位置

   {$R *.dfm}

procedure TF_WEB_UPDATE.FormCreate(Sender: TObject);
var
   servers: TStrings;
   i: integer;
begin
   self.sj := true;
   ClientSocket1 := TClientSocket.create(application);
   ClientSocket1.ClientType := ctBlocking;
   files := TStringList.Create;
   Notebook_step.PageIndex := 0;
   ListBox_servers.Items.Clear;
   try
      g_path := ExtractFilePath(application.ExeName);
      if copy(g_path, length(g_path), 1) <> '\' then g_path := g_path + '\';
      AppIni := TIniFile.Create(g_path + 'chis.ini');
      sys_id := AppIni.ReadString('chis', 'SubSys', '');
      servers := TStringList.Create;
      AppIni.ReadSectionValues('update', servers);
      for i := 0 to servers.Count - 1 do
         begin
            ListBox_servers.Items.Add(copy(servers[i], 1, pos('=', servers[i]) - 1));
            if i = 0 then Edt_url.Text := copy(servers[i], pos('=', servers[i]) + 1, length(servers[i]));
         end;
   finally
      AppIni.Free;
   end;

   //  self.filename1:=ini1.ReadString('file1','filename1','c:\temp1.dat');
end;

function getfiledate(const filename2: string; var d: TDateTime): Boolean;
var
   DosFileTime: integer;
begin
   result := false;
   DosFileTime := FileAge(filename2);
   if DosFileTime <> -1 then //返回-1表示文件不存在
      begin
         d := FileDateToDateTime(DosFileTime);
         result := true;
      end;
end;

function socket_rec_line1(socket1: TCustomWinSocket; timeout1: integer; crlf1: string = #13#10): string;
var
   buf1: Tbuf_char;
   r1: integer;
   ts1: TStringStream; //保存所有的数据
   FSocketStream: TWinSocketStream;
begin
   ts1 := TStringStream.Create('');
   FSocketStream := TWinSocketStream.create(Socket1, timeout1);
   //while true do//下面的一句更安全,不过对本程序好象没起作用
   while (socket1.Connected = true) do
      begin
         //确定是否可以接收数据
         //只能确定接收的超时，可见WaitForData的源码
         if not FSocketStream.WaitForData(timeout1) then break; //continue;
         //这一句是一定要有的，以免返回的数据不正确
         zeromemory(@buf1, sizeof(buf1));
         r1 := FsocketStream.Read(buf1, 1); //每次只读一个字符，以免读入了命令外的数据
         //读不出数据时也要跳出，要不会死循环
         if r1 = 0 then break; //test
         //用FsocketStream.Read能设置超时
         //r1:=socket1.ReceiveBuf(buf1,sizeof(buf1));
         ts1.Write(buf1, r1);
         //读到回车换行符了
         if pos(crlf1, ts1.DataString) <> 0 then
            begin
               break;
            end;
      end;
   result := ts1.DataString;
   //没有读到回车换行符,就表示有超时错，这时返回空字符串
   if pos(crlf1, result) = 0 then
      begin
         result := '';
      end;
   ts1.Free;
   FSocketStream.Free;
end;

function get_host1(in1: string): string;
begin
   in1 := trim(in1);
   if pos('http://', lowercase(in1)) = 1 then
      begin
         in1 := copy(in1, length('http://') + 1, length(in1));
      end;
   if pos('/', in1) <> 0 then
      begin
         in1 := copy(in1, 0, pos('/', in1) - 1);
      end;
   result := in1;
end;

function get_file1(in1: string): string;
begin
   in1 := trim(in1);
   if pos('http://', lowercase(in1)) = 1 then
      begin
         in1 := copy(in1, length('http://') + 1, length(in1));
      end;
   if pos('/', in1) <> 0 then
      begin
         in1 := copy(in1, pos('/', in1) + 1, length(in1));
      end;
   result := in1;
end;

function Download(var host1, file1: string): Boolean;
var
   f1: file;
   buf1: Tbuf_byte;
   rec1: longint;
   url1: string;
   cmd1: string; //这一行的内容
   value1: string; //标志们的值
   reclen1, real_reclen1: longint; //服务器返回的长度;实际已经收到的长度
   total_len1: longint; //数据总长
begin
   try
      //self.filename1:='c:\temp1.dat';
      assignfile(f1, file1);
      F_WEB_UPDATE.can_rec1 := false;
      F_WEB_UPDATE.stop1 := false;
      if FileExists(file1) = true then
         begin
            reset(f1, 1);
            pos1 := filesize(f1);
         end
      else
         begin
            rewrite(f1, 1);
            pos1 := 0;
         end;
      seek(f1, pos1);
      F_WEB_UPDATE.ClientSocket1.Active := false;
      F_WEB_UPDATE.ClientSocket1.Host := get_host1(host1);
      F_WEB_UPDATE.ClientSocket1.Port := 80;
      url1 := '';
      F_WEB_UPDATE.serfilename := get_file1(host1);
      F_WEB_UPDATE.serhost1 := get_host1(host1);
      //取得文件长度以确定什么时候结束接收[通过"head"请求得到]
      F_WEB_UPDATE.ClientSocket1.Active := false;
      F_WEB_UPDATE.ClientSocket1.Active := true;
      url1 := '';
      url1 := url1 + 'HEAD /' + F_WEB_UPDATE.serfilename + ' HTTP/1.1' + #13#10;
      //不使用缓存,我附加的
      //与以前的服务器兼容
      url1 := url1 + 'Pragma: no-cache' + #13#10;
      //新的
      url1 := url1 + 'Cache-Control: no-cache' + #13#10;
      //不使用缓存,我附加的_end;
      url1 := url1 + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)' + #13#10;
      //下面这句必须要有
      //url1:=url1+'Host: clq.51.net'+#13#10;
      url1 := url1 + 'Host: ' + F_WEB_UPDATE.serhost1 + #13#10;
      url1 := url1 + #13#10;
      F_WEB_UPDATE.ClientSocket1.Socket.SendText(url1);
      while F_WEB_UPDATE.ClientSocket1.Active = true do
         begin
            if F_WEB_UPDATE.stop1 = true then break;
            cmd1 := socket_rec_line1(F_WEB_UPDATE.ClientSocket1.Socket, 60 * 1000);
            //计算文件的长度
            if pos(lowercase('Content-Length: '), lowercase(cmd1)) = 1 then
               begin
                  value1 := copy(cmd1, length('Content-Length: ') + 1, length(cmd1));
                  total_len1 := strtoint(trim(value1));
               end;
            //计算文件的长度_end;
            if cmd1 = #13#10 then break;
         end;
      //取得文件长度以确定什么时候结束接收_end;
      //发送get请求，以得到实际的文件数据
      F_WEB_UPDATE.clientsocket1.Active := false;
      F_WEB_UPDATE.clientsocket1.Active := true;
      url1 := '';
      //url1:=url1+'GET http://clq.51.net/textfile.zip HTTP/1.1'+#13#10;
      //url1:=url1+'GET /textfile.zip HTTP/1.1'+#13#10;
      url1 := url1 + 'GET /' + F_WEB_UPDATE.serfilename + ' HTTP/1.1' + #13#10;
      url1 := url1 + 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*' + #13#10;
      //应该可以不要url1:=url1+'Accept-Language: zh-cn'+#13#10;
      //应该可以不要url1:=url1+'Accept-Encoding: gzip, deflate'+#13#10;
      //不使用缓存,我附加的
      //与以前的服务器兼容
      //url1:=url1+'Pragma: no-cache'+#13#10;
      //新的
      //url1:=url1+'Cache-Control: no-cache'+#13#10;
      //不使用缓存,我附加的_end;
      url1 := url1 + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)' + #13#10;
      //接受数据的范围,可选
      //url1:=url1+'RANGE: bytes=533200-'+#13#10;
      url1 := url1 + 'RANGE: bytes=' + inttostr(pos1) + '-' + #13#10;
      //下面这句必须要有
      //url1:=url1+'Host: clq.51.net'+#13#10;
      url1 := url1 + 'Host: ' + F_WEB_UPDATE.serhost1 + #13#10;
      //应该可以不要
      //url1:=url1+'Connection: Keep-Alive'+#13#10;
      url1 := url1 + #13#10;
      F_WEB_UPDATE.ClientSocket1.Socket.SendText(url1);
      while F_WEB_UPDATE.ClientSocket1.Active = true do
         begin
            if F_WEB_UPDATE.stop1 = true then break;
            cmd1 := socket_rec_line1(F_WEB_UPDATE.ClientSocket1.Socket, 60 * 1000);
            //是否可接收
            if pos(lowercase('Content-Range:'), lowercase(cmd1)) = 1 then
               begin
                  F_WEB_UPDATE.can_rec1 := true;
               end;
            //是否可接收_end;
            //计算要接收的长度
            if pos(lowercase('Content-Length: '), lowercase(cmd1)) = 1 then
               begin
                  value1 := copy(cmd1, length('Content-Length: ') + 1, length(cmd1));
                  reclen1 := strtoint(trim(value1));
               end;
            //计算要接收的长度_end;
            //头信息收完了
            if cmd1 = #13#10 then break;
         end;
      real_reclen1 := 0;
      while F_WEB_UPDATE.ClientSocket1.Active = true do
         begin
            if F_WEB_UPDATE.stop1 = true then break;
            //不能接收则退出
            if F_WEB_UPDATE.can_rec1 = false then break;
            //如果文件当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
            if filesize(f1) >= total_len1 then
               begin
                  //showmessage('文件已经下载完毕了！');
                  result := true;
                  F_WEB_UPDATE.Memo1.Lines.Add(file1 + '文件下载完成' + #13#10);
                  break;
               end;
            zeromemory(@buf1, sizeof(buf1));