TFile.Copy(SrcFile, DstFile, True);   

{*******************************************************}
{                File Get Utility Unit                  }
{          (C) 2015 Hideaki Tominaga (DEKO)             }
{*******************************************************}

{ ---------------------------------------------------------------------------- }
// USAGE:
//
// ・FILE (Local)
//   FileGet(fgpFile, '', 'C:\PICTURE\SAMPLE.JPG', 'C:\TEST\SAMPLE.JPG');
//
// ・FILE (Network)
//   FileGet(fgpFile, 'FILE-SERVER', '\PICTURE\SAMPLE.JPG', 'C:\TEST\SAMPLE.JPG');
//
// ・FILE (Network with Login)
//   FileGet(fgpFile, 'FILE-SERVER', '\PICTURE\SAMPLE.JPG', 'C:\TEST\SAMPLE.JPG', 'USER', 'PASS');
//
// ・HTTP
//   FileGet(fgpHTTP, 'www.sample.com', '/picture/sample.jpg', 'C:\TEST\SAMPLE.JPG');
//
// ・HTTPS
//   FileGet(fgpHTTPS, 'www.sample.com', '/picture/sample.jpg', 'C:\TEST\SAMPLE.JPG');
//
// ・HTTP (with Authentication)
//   FileGet(fgpHTTP, 'www.sample.com', '/picture/sample.jpg', 'C:\TEST\SAMPLE.JPG', 'USER', 'PASS');
//
// ・HTTP (with Port)
//   FileGet(fgpHTTP, 'www.sample.com', '/picture/sample.jpg', 'C:\TEST\SAMPLE.JPG', '', '', 8080);
//
// ・FTP
//   FileGet(fgpFTP, 'ftp.sample.com', '/picture/sample.jpg', 'C:\TEST\SAMPLE.JPG', 'USER', 'PASS');
//
// ・FTP (with Passive)
//   FileGet(fgpFTP, 'ftp.sample.com', '/picture/sample.jpg', 'C:\TEST\SAMPLE.JPG', 'USER', 'PASS', 0, True);
//
{ ---------------------------------------------------------------------------- }

unit uFileGet;

interface

{$IFDEF CONDITIONALEXPRESSIONS}
  {$IF CompilerVersion >= 25.0}
    {$LEGACYIFEND ON}
  {$IFEND}
  {$IF CompilerVersion >= 21.0}
    {$DEFINE D2010OVER}
  {$IFEND}
{$ENDIF}

uses
  SysUtils, Classes,
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
  {$IFDEF D2010OVER}
  IOUtils,
  {$ENDIF}
  IdBaseComponent, IdComponent, IdTCPConnection, IdFTPCommon,
  IdTCPClient, IdExplicitTLSClientServerBase, IdHTTP, IdFTP,
  IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL,
  IdAuthentication, IdAuthenticationDigest;

type
  TFleGetProtocol = (fgpFile, fgpHTTP, fgpHTTPS, fgpFTP);

  { TFileGet }
  TFileGet = class
  private
    FHost: string;
    FPort: WORD;
    FPass: string;
    FUser: string;
    FSecure: Boolean;
    FPassive: Boolean;
  public
    constructor Create; virtual;
    function Get(Src, Dst: string): Boolean; virtual; abstract;
    property Host: string read FHost write FHost;
    property User: string read FUser write FUser;
    property Pass: string read FPass write FPass;
    property Port: WORD read FPort write FPort;
    property Passive: Boolean read FPassive write FPassive;
    property Secure: Boolean read FSecure write FSecure;
  end;

  { TFTPFileGet }
  TFTPFileGet = class(TFileGet)
  public
    function Get(Src, Dst: string): Boolean; override;
  end;

  { THTTPFileGet }
  THTTPFileGet = class(TFileGet)
  private
    FNeedReload: Boolean;
    procedure IdHTTP_Authorization(Sender: TObject;
      Authentication: TIdAuthentication; var Handled: Boolean);
  public
    function Get(Src, Dst: string): Boolean; override;
  end;

  { TSMBFileGet }
  TSMBFileGet = class(TFileGet)
  public
    function Get(Src, Dst: string): Boolean; override;
  end;

  // FileGet()
  function FileGet(aProtocol: TFleGetProtocol; aHost, aSrc, aDst: string;
    aUser: string = ''; aPass: string = ''; aPort: WORD = 0; aPassive: Boolean = False): Boolean;

implementation

procedure MakeDirectory(aDir: string);
begin
  // ディレクトリが存在しなければ作成
  if not DirectoryExists(ExtractFilePath(aDir)) then
    try
      ForceDirectories(ExtractFilePath(aDir));
    except
    end;
end;

{ TFileGet }

constructor TFileGet.Create;
begin
  FHost := '';
  FPass := '';
  FUser := '';
  FPort := 0;
  FSecure := False;
  FPassive := False;
end;

{ TFTPFileGet }

function TFTPFileGet.Get(Src, Dst: string): Boolean;
// http://mrxray.on.coocan.jp/Delphi/plSamples/773_Indy_FTPGetPut.htm
var
  IdFTP: TIdFTP;
  FS: TFileStream;
begin
  // FTP で接続
  Result := False;
  MakeDirectory(Dst);
  IdFTP := TIdFTP.Create(nil);
  try
    IdFTP.Host         := FHost;
    if FPort = 0 then
      IdFTP.Port := 21
    else
      IdFTP.Port := FPort;
    IdFTP.Passive      := FPassive;
    IdFTP.Username     := FUser;
    IdFTP.Password     := FPass;
    IdFTP.TransferType := ftBinary;
    FS := TFileStream.Create(Dst, fmCreate);
    try
      IdFTP.Connect;
      IdFTP.Get(Src, FS);
      IdFTP.Disconnect;
      Result := True;
    except
    end;
    FS.Free;
  finally
    IdFTP.Free;
  end;
end;

{ THTTPFileGet }

function THTTPFileGet.Get(Src, Dst: string): Boolean;
// http://mrxray.on.coocan.jp/Delphi/plSamples/772_Indy_HTTPGet.htm
var
  lStream: TMemoryStream;
  lUrl: string;
  lProtocol: string;
  lPort: string;
  IdHTTP: TIdHTTP;
begin
  // HTTP で接続
  Result := False;
  MakeDirectory(Dst);
  IdHTTP := TIdHTTP.Create(nil);
  lStream := TMemoryStream.Create;
  try
    FNeedReload := False;
    IdHTTP.OnAuthorization := IdHTTP_Authorization;
    if FSecure then
      begin
        lProtocol := 'https';
        IdHTTP.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create;
      end
    else
      begin
        lProtocol := 'http';
      end;
    if FPort = 0 then
      lPort := ''
    else
      lPort := Format(':%d', [FPort]);
    lUrl := Format('%s://%s%s%s', [lProtocol, FHost, lPort, Src]);
    try
      IdHTTP.Head(lUrl);
      Result := True;
    except
    end;
    if not Result then
      Exit;
    Result := False;
    if (FUser <> '') and (IdHTTP.Request.Authentication = nil) then
      begin
        // BASIC 認証
        IdHTTP.Request.Clear;
        IdHTTP.Request.BasicAuthentication := True;
        IdHTTP.Request.Username := FUser;
        IdHTTP.Request.Password := FPass;
      end;
    try
      IdHTTP.Get(lUrl, lStream);
      Result := True;
    except
    end;
    lStream.Position := 0;
    lStream.SaveToFile(Dst);
  finally
    lStream.Free;
    IdHTTP.Free;
  end;
end;

procedure THTTPFileGet.IdHTTP_Authorization(Sender: TObject;
  Authentication: TIdAuthentication; var Handled: Boolean);
begin
  // Digest 認証
  Authentication.Username := Self.FUser;
  Authentication.Password := Self.FPass;
  if Authentication is TIdDigestAuthentication then
    begin
      TIdDigestAuthentication((Sender as TIdHTTP).Request.Authentication).Uri := (Sender as TIdHTTP).Request.URL;
      TIdDigestAuthentication(Authentication).Method := 'GET';
    end;
  Handled := True;
  FNeedReload := True;
end;

{ TSMBFileGet }

function TSMBFileGet.Get(Src, Dst: string): Boolean;
// http://owlsperspective.blogspot.jp/2008/07/wnetaddconnection2.html
var
  NewConnection: Boolean;
  lSrcPath, lSrcDir: string;
  lResult: Integer;
  {$IFDEF MSWINDOWS}
  { DoLogOn BEGIN }
  function DoLogOn(var RemotePath: string; const UserName: string;
    const Password: string): Integer;
  var
    NR: TNetResource;
  begin
    RemotePath := ExcludeTrailingPathDelimiter(RemotePath);
    with NR do
      begin
        dwType       := RESOURCETYPE_ANY;
        lpLocalName  := nil;
        lpRemoteName := PChar(RemotePath);
        lpProvider   := nil;
      end;
    Result := WNetAddConnection2(NR, PChar(Password), PChar(UserName), 0);
  end;
  { DoLogOn END }
  { DoLogOff BEGIN }
  function DoLogOff(const RemotePath: string): Integer;
  var
    PathName: string;
  begin
    PathName := RemotePath;
    Result := WNetCancelConnection2(PChar(PathName), 0, False);
  end;
  { DoLogOff END }
  {$ENDIF}
begin
  result := False;
  NewConnection := False;
  MakeDirectory(Dst);
  if FHost <> '' then
    begin
      lSrcPath := Format('\\?\UNC\%s%s', [FHost, Src]);            // UNC パス (ファイル、拡張 UNC パス)
      lSrcDir  := ExtractFilePath(Format('\\%s%s', [FHost, Src])); // UNC パス (ディレクトリ)
    end
  else
    begin
      lSrcPath := Src;
      lSrcDir  := Src;
    end;
  {$IFDEF MSWINDOWS}
  // ネットワーク資源にユーザー名/パスワードを指定して接続
  if FUser <> '' then
    begin
      lResult := DoLogOn(lSrcDir, FUser, FPass);
      if (lResult <> ERROR_ALREADY_ASSIGNED) and (lResult <> ERROR_SESSION_CREDENTIAL_CONFLICT) then
        begin
          // 接続されていなければ接続
          lResult := DoLogOn(lSrcDir, FUser, FPass);
          if lResult <> NO_ERROR then
            Exit;
          NewConnection := True;
        end;
    end
  else
  {$ENDIF}
    begin
      // ファイル存在確認
      {$IFDEF D2010OVER}
      if not TFile.Exists(lSrcPath) then
        Exit;
      {$ELSE}
      if not FileExists(lSrcPath) then
        Exit;
      {$ENDIF}
    end;
  // ファイルコピー
  {$IFDEF D2010OVER}
  TFile.Copy(lSrcPath, Dst, True);
  {$ELSE}
  CopyFile(PChar(lSrcPath), PChar(Dst), False);
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  // 新規で接続されていたら切断
  if NewConnection then
    DoLogOff(lSrcDir);
  {$ENDIF}
  result := True;
end;

function FileGet(aProtocol: TFleGetProtocol; aHost, aSrc, aDst: string;
  aUser: string; aPass: string; aPort: WORD; aPassive: Boolean): Boolean;
var
  FG: TFileGet;
begin
  case aProtocol of
    fgpHTTP, fgpHTTPS:
      FG := THTTPFileGet.Create;
    fgpFTP:
      FG := TFTPFileGet.Create;
  else
    FG := TSMBFileGet.Create;
  end;
  try
    FG.Host    := aHost;
    FG.Port    := aPort;
    FG.User    := aUser;
    FG.Pass    := aPass;
    FG.Secure  := (aProtocol = fgpHTTPS);
    FG.Passive := aPassive;
    result := FG.Get(aSrc, aDst);
  finally
    FG.Free;
  end;
end;

end.

{*******************************************************}
{                   Zip Utility Unit                    }
{          (C) 2015 Hideaki Tominaga (DEKO)             }
{*******************************************************}

unit uZipUtils;

{$IFDEF CONDITIONALEXPRESSIONS}
  {$IF CompilerVersion >= 25.0}
    {$LEGACYIFEND ON}
  {$IFEND}
  {$IF CompilerVersion >= 21.0}
    {$DEFINE D2010OVER}
  {$IFEND}
  {$IF CompilerVersion >= 23.0}
    {$DEFINE DXE2OVER}
  {$IFEND}
{$ENDIF}

interface

uses
  {$IFDEF D2010OVER}
  IOUtils,
  {$ENDIF}
  {$IFDEF DXE2OVER}
  Zip,
  {$ELSE}
  AbZipper, AbBase, AbBrowse, AbZBrows, AbUnzper, AbArcTyp,
  {$ENDIF}
  SysUtils;

  procedure DecompressZip(aZipFile: string; aDst: string);
  {$IFNDEF D2010OVER}
  procedure Directory_Delete(const Dir: string);
  {$ENDIF}

implementation

{$IFNDEF D2010OVER}
procedure Directory_Delete(const Dir: string);
var
  sDir: string;
  Rec: TSearchRec;
begin
  sDir := IncludeTrailingPathDelimiter(Dir);
  if FindFirst(sDir + '*.*', faAnyFile, Rec) = 0 then
    try
      repeat
        if (Rec.Attr and faDirectory) = faDirectory then
          begin
            if (Rec.Name <> '.') and (Rec.Name <> '..') then
              Directory_Delete(sDir + Rec.Name);
          end
        else
          DeleteFile(sDir + Rec.Name);
      until FindNext(Rec) <> 0;
    finally
      FindClose(Rec);
    end;
  RemoveDir(sDir);
end;
{$ENDIF}

procedure DecompressZip(aZipFile: string; aDst: string);
var
  lOutput: string;
{$IFNDEF DXE2OVER}
  Unzipper: TAbUnZipper;
{$ENDIF}
begin
{$IFDEF DXE2OVER}
// Use System.Zip
  if not TFile.Exists(aZipFile) then
    Exit;
  lOutput := IncludeTrailingPathDelimiter(aDst);
  TZipFile.ExtractZipFile(aZipFile, lOutput);
{$ELSE}
// Use TurboPower Abbrevia
  if not FileExists(aZipFile) then
    Exit;
  UnZipper := TAbUnZipper.Create(nil);
  try
    lOutput := ExcludeTrailingPathDelimiter(aDst);
    UnZipper.BaseDirectory := lOutput;
    UnZipper.ExtractOptions := [eoCreateDirs, eoRestorePath];
    UnZipper.FileName := aZipFile;
    UnZipper.ExtractFiles('*.*');
  finally
    UnZipper.Free;
  end
{$ENDIF}
end;

end.