unit _HTTPSocket;

interface

uses
  Forms,Windows, SysUtils, Classes, _netconst,
  IdException, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, INIFiles;

type
  THTTPSocket = class
    procedure IdHTTPConnected(Sender: TObject);
    procedure IdHTTPDisconnected(Sender: TObject);
    procedure IdHTTPStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
    procedure IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdHTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdHTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
  private
    { Private 宣言 }
    onNetworkProgressStart:TNetworkProgressStart;
    onNetworkProgressRefresh:TNetworkProgressRefresh;
    onNetworkProgressEnd:TNetworkProgressEnd;
    StartDir:string;
    NeedFile:TNeedFile;
    LogLst:TStrings;
    FileSize:integer;
    LastUpdateTickCount:dword;
    UseFindMirror:boolean;
    MirrorHost:string;
    MirrorPort:integer;
    TimeoutSec:integer;
    procedure ResponseAdd(mes:string);
    procedure LogLstSaveToFile;
    procedure CheckStream;
    procedure WriteBuffer2File(const Filename:string;const buf:array of byte;const count:integer);
  public
    BufferCount:integer;
    Buffer:array of byte;
    NetworkResult:integer;
    NetworkErrorCode:integer;
    NetworkErrorMessage:string;
    procedure Startup(_UseFindMirror:boolean;_TimeoutSec:integer;_onNetworkProgressStart:TNetworkProgressStart;_onNetworkProgressRefresh:TNetworkProgressRefresh;_onNetworkProgressEnd:TNetworkProgressEnd);
    procedure FreeMemory;
    function SelectMirrorServer(msg:string):boolean;
    procedure SetNeedFile(_NeedFile:TNeedFile);
    procedure GetHTTPFile(msg:string);
  end;

implementation

uses SelMirSrvDlg;

procedure THTTPSocket.ResponseAdd(mes:string);
begin
  LogLst.Add(mes);
end;

procedure THTTPSocket.LogLstSaveToFile;
var
  Filename:string;
  tf:TextFile;
begin
  Filename:=StartDir+'network.log';
  AssignFile(tf,Filename);
  if FileExists(Filename)=False then begin
    Rewrite(tf);
    end else begin
    Append(tf);
  end;
  Writeln(tf,LogLst.Text);
  CloseFile(tf);
end;

procedure THTTPSocket.Startup(_UseFindMirror:boolean;_TimeoutSec:integer;_onNetworkProgressStart:TNetworkProgressStart;_onNetworkProgressRefresh:TNetworkProgressRefresh;_onNetworkProgressEnd:TNetworkProgressEnd);
begin
  StartDir:=ExtractFileDir(Application.ExeName)+'\';

  LogLst:=TStringList.Create;
  LogLst.Clear;

  with NeedFile do begin
    NetworkResult:=ResultSuccess;
    NetworkErrorCode:=hsNoError;
    NetworkErrorMessage:=hmNoError;
  end;

  UseFindMirror:=_UseFindMirror;
  MirrorHost:='';
  MirrorPort:=0;

  if _TimeoutSec=0 then begin
    TimeoutSec:=5;
    end else begin
    TimeoutSec:=_TimeoutSec;
  end;

  onNetworkProgressStart:=_onNetworkProgressStart;
  onNetworkProgressRefresh:=_onNetworkProgressRefresh;
  onNetworkProgressEnd:=_onNetworkProgressEnd;
end;

procedure THTTPSocket.FreeMemory;
begin
  LogLst.Free;
end;

function THTTPSocket.SelectMirrorServer(msg:string):boolean;
begin
  Application.CreateForm(TSelMirSrv, SelMirSrv);
  SelMirSrv.Init(msg);
  SelMirSrv.LoadServerList;
  SelMirSrv.ShowModal;
  Result:=SelMirSrv.RetryFlag;
  if Result=True then begin
    MirrorHost:=SelMirSrv.MirrorHost;
    MirrorPort:=SelMirSrv.MirrorPort;
  end;
  SelMirSrv.FreeMemory;
  SelMirSrv.Release;
end;

procedure THTTPSocket.SetNeedFile(_NeedFile:TNeedFile);
begin
  NeedFile:=_NeedFile;
end;

procedure THTTPSocket.GetHTTPFile(msg:string);
var
  IdHTTP:TIdHTTP;
  res:string;
  RetryFlag:boolean;
  RetryCount:integer;
  INIfn:string;
  INI:TINIFile;
  procedure SetHTTPParams;
  begin
    with IdHTTP do begin
      AllowCookies:=False;
      ASCIIFilter:=False;
      HandleRedirects:=False;
      Host:=NeedFile.Host;
      Port:=NeedFile.Port;
      ProtocolVersion:=pv1_1;
      ReadTimeout:=TimeoutSec*1000;
      RecvBufferSize:=NeedFile.BufferSize;
      SendBufferSize:=NeedFile.BufferSize;

      ProxyParams.ProxyPort:=0;
      ProxyParams.ProxyServer:='';

      Request.Host:=IdHTTP.Host;
      Request.URL:=NeedFile.URL;
      Request.UserAgent:=NeedFile.UserAgent;

      OnConnected:=IdHTTPConnected;
      OnDisconnected:=IdHTTPDisconnected;
      OnStatus:=IdHTTPStatus;
      OnWork:=IdHTTPWork;
      OnWorkBegin:=IdHTTPWorkBegin;
      OnWorkEnd:=IdHTTPWorkEnd;
    end;
  end;
begin
{
  if IdHTTP<>nil then begin
    ShowMessage('回復不能な予測しないエラーが発生しました。'+CRLF+'既に通信ソケットは開かれています。');
    NeedFile.NetworkResult:=ResultAlredySocketError;
    exit;
  end;
}

  BufferCount:=0;
  SetLength(Buffer,BufferCount);

  LogLst.Clear;
  ResponseAdd('StartProcess:'+FormatDateTime('yyy/mm/dd-hh:mm:ss',now));

  if (MirrorHost<>'') and (MirrorPort<>0) then begin
    NeedFile.Host:=MirrorHost;
    NeedFile.Port:=MirrorPort;
  end;

  INIfn:=ExtractFilePath(Application.ExeName)+'NetworkOverride.ini';
  if FileExists(INIfn)=True then begin
    INI:=TINIFile.Create(INIfn);
    if INI.ReadBool('override','enabled',False)=True then begin
      NeedFile.Host:=INI.ReadString('override','host','');
      NeedFile.Port:=INI.ReadInteger('override','port',0);
    end;
    INI.Free;
  end;

  RetryFlag:=True;
  RetryCount:=0;

  if assigned(onNetworkProgressStart) then onNetworkProgressStart(msg);

  IdHTTP:=nil;

  while (RetryFlag=True) do begin
    RetryFlag:=UseFindMirror;

    if IdHTTP<>nil then IdHTTP.Free;
    IdHTTP:=TIdHTTP.Create(nil);
    SetHTTPParams;

    with IdHTTP do begin
      ResponseAdd('Request[Host]:'+Host);
      ResponseAdd('Request[Port]:'+inttostr(Port));
      ResponseAdd('Request[URL]:'+Request.URL);
      ResponseAdd('Request[UserAgent]:'+Request.UserAgent);
    end;
    with NeedFile do begin
      ResponseAdd('Request[WriteFileSize]:'+inttostr(WriteFileSize));
      ResponseAdd('Request[WriteFileCheckSum]:'+inttohex(WriteFileCheckSum,8));
      if WriteFilename='' then begin
        ResponseAdd('Request[WriteFilename]:MemoryReserve');
        end else begin
        ResponseAdd('Request[WriteFilename]:'+WriteFilename);
      end;
    end;

    LastUpdateTickCount:=0;
    FileSize:=0;
    with NeedFile do begin
      NetworkResult:=ResultNowProcess;
      NetworkErrorCode:=hsNoError;
      NetworkErrorMessage:=hmNoError;
    end;
    try
      res:=IdHTTP.Get(IdHTTP.Request.URL);
      IdHTTP.Disconnect;
      with NeedFile do begin
        BufferCount:=Length(res);
        SetLength(Buffer,BufferCount);
        if BufferCount<>0 then begin
          MoveMemory(@Buffer[0],@res[1],BufferCount);
        end;
        CheckStream;
      end;
      if BufferCount=0 then begin
        NetworkResult:=ResultFileTransferError;
        NetworkErrorMessage:='実ファイル転送に失敗しました。';
        RetryFlag:=True;
        end else begin
        RetryFlag:=False;
      end;
      except
      on E:EIdSocketError do begin
        NetworkResult:=ResultSocketError;
        NetworkErrorMessage:=E.Message;
      end;
      on E:EIdHTTPProtocolException do begin
        if pos('404',E.Message)<>0 then begin
          NetworkResult:=Result404Error;
          RetryFlag:=False;
          end else begin
          NetworkResult:=hsErrorResponse;
          NetworkErrorMessage:=E.Message;
        end;
      end;
      on E:EIdConnectTimeout do begin
        NetworkResult:=ResultTimeout;
        NetworkErrorMessage:=E.Message;
      end;
      else begin
        NetworkResult:=hsErrorResponse;
        NetworkErrorMessage:='未定義エラー';
      end;
    end;
    if RetryFlag=True then begin
      inc(RetryCount);
      if (RetryCount mod 3)=0 then begin
        RetryFlag:=SelectMirrorServer('ホストが応答しませんでした。ミラーサーバを選択してください。');
      end;
      if RetryFlag=True then begin
        if (MirrorHost<>'') and (MirrorPort<>0) then begin
          NeedFile.Host:=MirrorHost;
          NeedFile.Port:=MirrorPort;
        end;
        SetHTTPParams;
      end;
    end;
    IdHTTP.Free;
    IdHTTP:=nil;
  end;

  if assigned(onNetworkProgressEnd) then onNetworkProgressEnd;

  if (NetworkResult<>ResultSuccess) or (NetworkErrorCode<>hsNoError) then begin
    with NeedFile do begin
      if NetworkErrorMessage='' then begin
        ResponseAdd('Terminal:'+format('Result=%d,Code=%d',[NetworkResult,NetworkErrorCode]));
        end else begin
        ResponseAdd('Terminal:'+format('Result=%d,Code=%d,[%s]',[NetworkResult,NetworkErrorCode,NetworkErrorMessage]));
      end;
    end;
    ResponseAdd('EndProcess:'+FormatDateTime('yyy/mm/dd-hh:mm:ss',now));
    if NetworkResult<>Result404Error then LogLstSaveToFile;
  end;
end;

procedure THTTPSocket.CheckStream;
var
  CheckSum:dword;
begin
  if BufferCount=0 then begin
    ResponseAdd('Error:FileSizeMismatch');
    NetworkResult:=ResultFileSizeMismatch;
  end;

  if ((NeedFile.WriteFileSize<>0) and (NeedFile.WriteFileSize<>BufferCount)) then begin
    ResponseAdd('Error:FileSizeMismatch');
    NetworkResult:=ResultFileSizeMismatch;
    end else begin
    ResponseAdd('Info:Transferred');
    CheckSum:=GetCheckSum(Buffer,BufferCount);
    ResponseAdd('Info:CheckSum('+inttohex(CheckSum,8)+')');
    if (NeedFile.WriteFileCheckSum<>0) and (NeedFile.WriteFileCheckSum<>CheckSum) then begin
      ResponseAdd('Info:CheckSumMismatch');
      NetworkResult:=ResultFlleCheckSumMismatch;
      end else begin
      if NeedFile.WriteFilename<>'' then begin
        WriteBuffer2File(NeedFile.WriteFilename,Buffer,BufferCount);
        ResponseAdd('Info:FileWrited');
        end else begin
        ResponseAdd('Info:FileMemoryMapped');
      end;
      NetworkResult:=ResultSuccess;
    end;
  end;
end;

procedure THTTPSocket.WriteBuffer2File(const Filename:string;const buf:array of byte;const count:integer);
var
  path:string;
  fs:TFileStream;
begin
  path:=ExtractFilePath(Filename);
  if DirectoryExists(path)=False then ForceDirectories(path);

  fs:=TFileStream.Create(Filename,fmCreate or fmShareDenyWrite);
  fs.WriteBuffer(buf[0],count);
  fs.Free;
end;

procedure THTTPSocket.IdHTTPConnected(Sender: TObject);
begin
  ResponseAdd('Info:Connected.');
end;

procedure THTTPSocket.IdHTTPDisconnected(Sender: TObject);
begin
  ResponseAdd('Info:Disconnected.');
end;

procedure THTTPSocket.IdHTTPStatus(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: String);
begin
  ResponseAdd('Info:'+AStatusText);
  if assigned(onNetworkProgressRefresh) then onNetworkProgressRefresh(True,False,AStatusText,0,0);
end;

procedure THTTPSocket.IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
var
  Status:string;
begin
  if (LastUpdateTickCount+100)<GetTickCount then begin
    LastUpdateTickCount:=GetTickCount;
    Status:='Download...'+format('%d/%d bytes.(%2.2fper)',[AWorkCount,FileSize,(AWorkCount/FileSize*100)]);
    if assigned(onNetworkProgressRefresh) then onNetworkProgressRefresh(True,True,Status,FileSize,AWorkCount);
  end;
end;

procedure THTTPSocket.IdHTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  FileSize:=AWorkCountMax;

  ResponseAdd('Info:WorkBegin('+Inttostr(AWorkCountMax)+'byte)');

  if assigned(onNetworkProgressRefresh) then onNetworkProgressRefresh(True,True,'Download Start.',FileSize,0);
end;

procedure THTTPSocket.IdHTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  ResponseAdd('Info:WorkEnd');

  if assigned(onNetworkProgressRefresh) then onNetworkProgressRefresh(True,True,'Download End.',0,0);
end;

end.
