unitmain.pas

文件传输,支持断点续传.支持各种协议,运用 WINSOCK 单元进行传送文件的程序

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ImgList, ComCtrls, Gauges,
  ScktComp, WinInet, IniFiles, ShellApi;

type
  TBufChar = array[0..4095] of Char;
  TBufByte = array[0..4095] of Byte;

type
  TFormUpdate = class(TForm)
    BtnPrior: TButton;
    BtnNext: TButton;
    Memo1: TMemo;
    BtnLog: TButton;
    BtnCancel: TButton;
    ImageList: TImageList;
    Image1: TImage;
    GroupBox1: TGroupBox;
    NotebookStep: TNotebook;
    ListBoxHosts: TListBox;
    GaugeProcess: TGauge;
    ListViewFiles: TListView;
    LabelMsg: TLabel;
    EditURL: TEdit;
    Label2: TLabel;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure BtnNextClick(Sender: TObject);
    procedure BtnPriorClick(Sender: TObject);
    procedure ListBoxHostsClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BtnCancelClick(Sender: TObject);
    procedure BtnLogClick(Sender: TObject);
    procedure EditURLChange(Sender: TObject);

    function CheckConnection: Boolean;
		function DownloadInfo: Boolean;
		function AnalysisInfo: Boolean;
		function DownloadFiles: Boolean;
    function UpdateFiles: Boolean;
  private
    ClientSocket1: TClientSocket;
    subSysFile: String; //子系统的更新文件名
    updatePath: String; //升级文件路径
    backupPath: String; //备份文件路径
    runExe: String;

    hosts: TStringList; //服务器列表
    files: TStringList; //要下载的文件列表

    downFileName: String; //下载文件名
    downHostName: String; //服务器名

    canRec: Boolean; //是否可以接收
    stoped: Boolean; //是否停止
    position: LongInt; //上次下载的断点位置
    iniFile: TIniFile; //通用ini
    step: Integer;

    procedure ReadIni;
    procedure WriteIni;
	public
		{ Public declarations }
	end;

var
  FormUpdate: TFormUpdate;

const
  CONFIGINI: String = 'config.ini';
  UPDATEINFO: String = 'info.ini'; //本地升级信息文件名

implementation

{$R *.dfm}

procedure TFormUpdate.WriteIni;
begin
  try
    iniFile:=TiniFile.Create(ExtractFilePath(Application.ExeName) + CONFIGINI);
    iniFile.WriteString('Updates', ';子系统的更新文件名SubSysFile', 'xxx.ini');
    iniFile.WriteString('Updates', ';升级完启动程序RunExe', 'xxx.exe');
    iniFile.WriteString('Updates', ';是否要升级（0需要,1永不升级）NoUpdate', '0');
    iniFile.WriteString('Hosts', ';主机名下载路径HostName', 'http://www.HostName.com/Path/');
  finally
    iniFile.Free;
  end;
end;

procedure TFormUpdate.ReadIni;
begin
  try
    iniFile := TiniFile.Create(ExtractFilePath(Application.ExeName) + CONFIGINI);
    subSysFile := iniFile.ReadString('Updates', 'SubSysFile', '');
    runExe := iniFile.ReadString('Updates', 'RunExe', '');
    iniFile.ReadSectionValues('Hosts', hosts);
    //检查subSysFile, Hosts是否合法
    //略
    updatePath := ExtractFilePath(Application.ExeName) + 'update\';
    backupPath := ExtractFilePath(Application.ExeName) + 'backup\';
    //检查updatePath, backupPath是否存在，否则建立
    //略
  finally
    iniFile.Free;
  end;
end;

procedure TFormUpdate.FormCreate(Sender: TObject);
var
  i: Integer;
begin
	NotebookStep.PageIndex := 0;
	ClientSocket1 := TClientSocket.Create(Application);
	ClientSocket1.ClientType := ctBlocking;
  if not FileExists(ExtractFilePath(Application.ExeName) + CONFIGINI) then WriteIni;

  hosts := TStringList.Create;
  ReadIni;
	for i:=0 to hosts.Count-1 do
	begin
		ListBoxHosts.Items.Add(Copy(hosts[i], 1, Pos('=', hosts[i])-1));
    hosts[i] := Copy(hosts[i], Pos('=', hosts[i])+1, Length(hosts[i]));
    if Copy(hosts[i], Length(hosts[i]), 1)<>'/' then	hosts[i] := hosts[i] + '/';
    ////if i=0 then EditURL.Text := hosts[i];
  end;
end;

//***********************************************
function GetHostName(str: String): String;
begin
  str := Trim(str);
  if Pos('http://', LowerCase(str)) = 1 then
    str := Copy(str, Length('http://') + 1, Length(str));
  if Pos('/', str) <> 0 then
    str := Copy(str, 0, Pos('/', str) - 1);
  result := str;
end;

function GetFileName(str: String): String;
begin
  str := Trim(str);
  if Pos('http://', LowerCase(str)) = 1 then
    str := Copy(str, Length('http://') + 1, Length(str));
  if Pos('/', str) <> 0 then
    str := Copy(str, Pos('/', str) + 1, Length(str));
  result := str;
end;

function GetFileDate(const fileName: String; var fileDate: TDateTime): Boolean;
var
  age: Integer;
begin
  result := false;
  age := FileAge(filename);
  if age <> -1 then //返回-1表示文件不存在
  begin
    fileDate := FileDateToDateTime(age);
    result := true;
  end;
end;

function SocketRecLine(socket: TCustomWinSocket; timeout: Integer; const CRLF: String = #13#10): String;
var
  bufChar: TBufChar;
  r: Integer;
  strStream: TStringStream; //保存所有的数据
  scktStream: TWinSocketStream;
begin
  strStream := TStringStream.Create('');
  scktStream := TWinSocketStream.Create(socket, timeout);

  //while true do//下面的一句更安全,不过对本程序好象没起作用
  while (socket.Connected = true) do
  begin
    //确定是否可以接收数据 //只能确定接收的超时，可见WaitForData的源码
    if not scktStream.WaitForData(timeout) then break; //continue;
    //这一句是一定要有的，以免返回的数据不正确
    ZeroMemory(@bufChar, SizeOf(bufChar));
    //每次只读一个字符，以免读入了命令外的数据
    r := scktStream.Read(bufChar, 1);
    //读不出数据时也要跳出，要不会死循环
    if r = 0 then break; //test
    //用scktStream.Read能设置超时
    //r:=socket.ReceiveBuf(bufChar, SizeOf(bufChar));
    strStream.Write(bufChar, r);
    //读到回车换行符了
    if Pos(CRLF, strStream.DataString) <> 0 then break;
  end;
  result := strStream.DataString;
  //没有读到回车换行符,就表示有超时错，这时返回空字符串
  if Pos(CRLF, result) = 0 then result := '';

  strStream.Free;
  scktStream.Free;
end;

function Download(var remote, local: String): Boolean;
var
  str: String;
  bufByte: TBufByte;
  bytes: LongInt;
  f: File;
  recLine, RECAll: String; //这一行的内容
  recLength, realLength: LongInt; //服务器返回的长度;实际已经收到的长度
  cl: String; //标志们的值
  totalLength: LongInt; //数据总长
begin
  result := false;
  recLength := 0;
  totalLength := 0;
  try
    AssignFile(f, local);
    FormUpdate.canRec := false;
    FormUpdate.stoped := false;
    if FileExists(local) = true then
    begin
      Reset(f, 1);
      FormUpdate.position := FileSize(f);
    end
    else
    begin
      ReWrite(f, 1);
      FormUpdate.position := 0;
    end;

    Seek(f, FormUpdate.position);
    FormUpdate.ClientSocket1.Active := false;
    FormUpdate.ClientSocket1.Host := GetHostName(remote);
    FormUpdate.ClientSocket1.Port := 80;

    str := '';
    FormUpdate.downFileName := GetFileName(remote);
    FormUpdate.downHostName := GetHostName(remote);


    //*****取得文件长度以确定什么时候结束接收*****[通过"head"请求得到]
    FormUpdate.ClientSocket1.Active := true;
    str := '';
    str := str + 'HEAD /' + FormUpdate.downFileName + ' HTTP/1.1' + #13#10;

    //-----不使用缓存-----我附加的
    //与以前的服务器兼容
    str := str + 'Pragma: no-cache' + #13#10;
    //新的
    str := str + 'Cache-Control: no-cache' + #13#10;
    //-----不使用缓存_end-----

    str := str + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)' + #13#10;

    //下面这句必须要有
    str := str + 'Host: ' + FormUpdate.downHostName + #13#10;
    str := str + #13#10;
    FormUpdate.ClientSocket1.Socket.SendText(str);


    while FormUpdate.ClientSocket1.Active = true do
    begin
      if FormUpdate.stoped = true then raise EMathError.Create('用户中断');
      recLine := SocketRecLine(FormUpdate.ClientSocket1.Socket, 60 * 1000);

      //-----计算文件的长度-----
      if Pos(LowerCase('Content-Length: '), LowerCase(recLine)) = 1 then
      begin
        cl := Copy(recLine, Length('Content-Length: ') + 1, Length(recLine));
        totalLength := StrToInt(Trim(cl));
      end;
      //-----计算文件的长度_end-----

      if recLine = #13#10 then break;
    end;
    FormUpdate.clientsocket1.Active := false;
    //*****取得文件长度以确定什么时候结束接收_end*****



    //*****发送get请求，以得到实际的文件数据*****
    FormUpdate.clientsocket1.Active := true;
    str := '';
    str := str + 'GET /' + FormUpdate.downFileName + ' HTTP/1.1' + #13#10;
    str := str + 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*' + #13#10;

    //应该可以不要str := str + 'Accept-Language: zh-cn' + #13#10;
    //应该可以不要str := str + 'Accept-Encoding: gzip, deflate' + #13#10;

    //-----不使用缓存-----我附加的
    //与以前的服务器兼容
    //str := str + 'Pragma: no-cache' + #13#10;
    //新的
    //str := str + 'Cache-Control: no-cache' + #13#10;
    //----不使用缓存-----end

    str := str + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)' + #13#10;
    //接受数据的范围,可选
    str := str + 'RANGE: bytes=' + IntToStr(FormUpdate.position) + '-' + #13#10;

    //下面这句必须要有
    str := str + 'Host: ' + FormUpdate.downHostName + #13#10;

    //应该可以不要
    //str := str + 'Connection: Keep-Alive' + #13#10;
    str := str + #13#10;
    FormUpdate.ClientSocket1.Socket.SendText(str);

    while FormUpdate.ClientSocket1.Active = true do
    begin
      if FormUpdate.stoped = true then raise EMathError.Create('用户中断');
      recLine := SocketRecLine(FormUpdate.ClientSocket1.Socket, 60 * 1000);

      //-----是否可接收-----
      if Pos(LowerCase('Content-Range:'), LowerCase(recLine)) = 1 then
      begin
        FormUpdate.canRec := true;
      end;
      //-----是否可接收-----end

      //-----计算要接收的长度-----
      if Pos(LowerCase('Content-Length: '), LowerCase(recLine)) = 1 then
      begin
        cl := Copy(recLine, Length('Content-Length: ') + 1, Length(recLine));
        recLength := StrToInt(Trim(cl));
      end;
      //-----计算要接收的长度-----end;
      RECAll:=RECAll+recLine;
      //头信息收完了
      if recLine = #13#10 then break;
    end;

    realLength := 0;
    while FormUpdate.ClientSocket1.Active = true do
    begin
      if FormUpdate.stoped = true then raise EMathError.Create('用户中断');

      //不能接收则退出
      if FormUpdate.canRec = false then
      begin
        FormUpdate.Memo1.Lines.Add(local + '文件下载失败');
        FormUpdate.Memo1.Lines.Add(RECALL);
        break;
      end;

      //如果文件当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
      if FileSize(f) >= totalLength then
      begin
        result := true;
        FormUpdate.Memo1.Lines.Add(local + '文件下载完成');
        break;
      end;

      ZeroMemory(@bufByte, SizeOf(bufByte));
      bytes := FormUpdate.ClientSocket1.Socket.ReceiveBuf(bufByte, SizeOf(bufByte));

      //如果实际收到的长度大于服务器标识的长度,则是出错了，不要写入文件中
      if realLength >= recLength then
      begin
        result := true;
        FormUpdate.Memo1.Lines.Add(FormUpdate.downFileName + '实际收到文件长度大于服务器标识长度，跳过下载');
        break;
      end;

      //如果当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
			if FormUpdate.position = recLength then
      begin
        result := true;
        FormUpdate.Memo1.Lines.Add(FormUpdate.downFileName + '当前长度大于服务器标识长度，跳过下载');
        break;
      end;

      BlockWrite(f, bufByte, bytes);
      realLength := realLength + bytes;

      //显示下载进度
      FormUpdate.LabelMsg.Caption := '共 ' + FormatFloat('#,##', recLength) + ' 字节，已下载 ' + FormatFloat('#,##', realLength) + ' 字节';
      FormUpdate.GaugeProcess.MaxValue := recLength;
      FormUpdate.GaugeProcess.Progress := realLength;
      //FormUpdate.NotebookStep.Refresh;
      Application.ProcessMessages;
    end;
    CloseFile(f);
    FormUpdate.ClientSocket1.Active := false;
    //*****发送get请求，以得到实际的文件数据_end*****
  except
    raise;
    CloseFile(f);
    FormUpdate.Memo1.Lines.Add(FormUpdate.downFileName + '服务器连接失败，取消下载');
    result := false;
    Exit;
  end;