httpget.pas

实现自制的程序的自动升级

  end;

begin
  //==========================================================================
  //检查本地是否有下载到一半的文件及说明文件
  LocalFileSize := 0;
  IniFile := FTFileName + DEF_INI_FILE_EXT;
  if FileExists(FTFileName) then
  begin
    if FileExists(IniFile) then //取出当时下载的文件在修改日期，用于和服务器比较是否还是同一文件
    begin
      ModiDate := GetFileModiDate(IniFile);
      if ModiDate <> '' then
      begin
        LocalFileSize := GetFileSize(FTFileName); //得到本地已下载的大小
      end;
    end;
  end;
  //==========================================================================
  try
    HostPort := '80';
    ParseURL(FTURL, HostName, FileName, HostPort);
    try
      nPort := StrToInt(HostPort);
    except
      nPort := 80;
    end;

    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),
      nPort, PChar(FTUserName), PChar(FTPassword),
      INTERNET_SERVICE_HTTP, 0, 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.1',
      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 := 2048;
    GetMem(Buf, dwBufLen);

    FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,
      Buf, dwBufLen, dwIndex);

    if FTResult or not FTBinaryData then
    begin
      if FTResult then
        FTFileSize := StrToInt(StrPas(Buf));
    end;
    //=====================================================
    dwIndex2 := 0;
    dwDateLen := 256;
    GetMem(pDate, dwDateLen);

    FTResult2 := HttpQueryInfo(hRequest, HTTP_QUERY_LAST_MODIFIED,
      pDate, dwDateLen, dwIndex2);

    if FTresult2 then
    begin
      ServerModiDate := StrPas(pDate);
      if ServerModiDate <> '' then
      begin
        SaveToFile1(ServerModiDate, IniFile);
      end;
    end;
    {   if ServerModiDate = ModiDate then
       begin
         if FTPostQuery = '' then
         begin
           UrlHeader := 'RANGE: bytes=' + IntToStr(LocalFileSize) + '-' +
             IntToStr(FTFileSize)
             + #13#10;
           HttpSendRequest(hRequest, pchar(UrlHeader), Length(UrlHeader), nil, 0);
         end
         else
         begin
           UrlHeader := 'Content-Type: application/x-www-form-urlencoded' + #13#10
             +
             'RANGE: bytes=' + IntToStr(LocalFileSize) + '-' + IntToStr(FTFileSize)
               + #13#10;
           HttpSendRequest(hRequest, pchar(UrlHeader), Length(UrlHeader),
             PChar(FTPostQuery), Length(FTPostQuery));
         end;
       end;      }
       //==================================================================
    if Terminated then
    begin
      FreeMem(Buf);
      FreeMem(pDate);
      CloseHandles;
      FTResult := False;
      Exit;
    end;

    //============================================================================
     //首先判断服务器支持不支持断点续传，不支持，则删除本地文件，重新下载.
     //支持，则生成新的请求头字符串，send到服务器上

     //============================================================================
    BytesReaded := 0;

    if FTToFile then
    begin
      AssignFile(f, FTFileName);
      if ServerModiDate = ModiDate then
      begin
        reset(f, 1);
        seek(f, localFileSize);
      end
      else
      begin
        Rewrite(f, 1);
      end;
    end
    else
      FTStringResult := '';

    if ServerModiDate = ModiDate then
    begin
      InternetCloseHandle(hRequest);
      hRequest := HttpOpenRequest(hConnect, RequestMethod, PChar(FileName),
        'HTTP/1.1', PChar(FTReferer), @AcceptType, InternetFlag, 0);
      if FTPostQuery = '' then
      begin
        UrlHeader := 'RANGE: bytes=' + IntToStr(LocalFileSize) + '-' +
          IntToStr(FTFileSize)
          + #13#10;
        HttpSendRequest(hRequest, pchar(UrlHeader), Length(UrlHeader), nil, 0);
      end
      else
      begin
        UrlHeader := 'Content-Type: application/x-www-form-urlencoded' + #13#10
          +
          'RANGE: bytes=' + IntToStr(LocalFileSize) + '-' + IntToStr(FTFileSize)
          + #13#10;
        HttpSendRequest(hRequest, pchar(UrlHeader), Length(UrlHeader),
          PChar(FTPostQuery), Length(FTPostQuery));
      end;
    end;

    while True do
    begin
      if Terminated then
      begin
        if FTToFile then
          CloseFile(f);
        FreeMem(Buf);
        FreeMem(pDate);
        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 - LocalFileSize) = Integer(BytesReaded)
    else
    begin
      SetLength(FTStringResult, BytesReaded);
      FTResult := BytesReaded <> 0;
    end;

    if FTToFile then
      CloseFile(f);

    FreeMem(Buf);
    FreeMem(pDate);
    CloseHandles;
  except
  end;
end;

// HTTPGet

constructor 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.