如何允许Windows服务(用Delphi编写)访问Amazon Bucket?

时间:2018-03-15 23:54:28

标签: delphi amazon-s3

我想创建一个Windows服务(使用Delphi),每小时都会尝试从特定的Amazon S3 Bucket中检索特定文件。

使用我的VCL应用程序访问Amazon S3 Bucket没有问题。但是,如果我尝试通过Windows服务运行相同的功能,它什么都不返回。我认为这是一个许可问题:我的服务不允许访问外部世界。

我应该怎么做才能解决我的问题?

我使用的是Delphi Tokyo Update 3,我的服务基于DataSnap服务器。

以下是我的“服务器容器”单元的代码:

unit UnitOurDataSnapServerContainer;

interface

uses
  System.SysUtils, System.Classes, System.Win.Registry, Vcl.SvcMgr,
  Datasnap.DSTCPServerTransport,
  Datasnap.DSServer, Datasnap.DSCommonServer,
  IPPeerServer, IPPeerAPI, Datasnap.DSAuth;

type
  TServerContainer_OurCompany = class(TService)
    DSServer_OurCompany: TDSServer;
    DSServerClass_OurCompany: TDSServerClass;
    DSTCPServerTransport_OurCompany: TDSTCPServerTransport;
    procedure DSServerClass_OurCompanyGetClass(DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
  private
    { Private declarations }
  protected
    function DoStop: Boolean; override;
    function DoPause: Boolean; override;
    function DoContinue: Boolean; override;
    procedure DoInterrogate; override;
  public
    function GetServiceController: TServiceController; override;
  end;

var
  ServerContainer_OurCompany: TServerContainer_OurCompany;

implementation


{$R *.dfm}

uses
  Winapi.Windows,
  UnitOurDataSnapServerMethods;

procedure TServerContainer_OurCompany.DSServerClass_OurCompanyGetClass(DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := UnitOurDataSnapServerMethods.TOurDataSnapServerMethods;
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  ServerContainer_OurCompany.Controller(CtrlCode);
end;

function TServerContainer_OurCompany.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

function TServerContainer_OurCompany.DoContinue: Boolean;
begin
  Result := inherited;
  DSServer_OurCompany.Start;
end;

procedure TServerContainer_OurCompany.DoInterrogate;
begin
  inherited;
end;

function TServerContainer_OurCompany.DoPause: Boolean;
begin
  DSServer_OurCompany.Stop;
  Result := inherited;
end;

function TServerContainer_OurCompany.DoStop: Boolean;
begin
  DSServer_OurCompany.Stop;
  Result := inherited;
end;

procedure TServerContainer_OurCompany.ServiceStart(Sender: TService; var Started: Boolean);
begin
{$IFDEF RELEASE}
  DSServer_OurCompany.HideDSAdmin := True;
{$ENDIF}

  DSServer_OurCompany.Start;
end;

end.

以下是我的'servermethods'单元的代码:

unit UnitOurDataSnapServerMethods;

interface

uses
  System.SysUtils, System.Classes, Datasnap.DSServer, Datasnap.DSAuth;

type
{$METHODINFO ON}
  TOurDataSnapServerMethods = class(TComponent)
  private
    { Private declarations }
  public
    { Public declarations }
    function Get_ListOfFilesInS3Bucket(aS3Path: String; aFileExtension: String) : Integer;
  end;
{$METHODINFO OFF}

implementation

uses
  Data.Cloud.CloudAPI, Data.Cloud.AmazonAPI;

function TOurDataSnapServerMethods.Get_ListOfFilesInS3Bucket(aS3Path: String; aFileExtension: String) : Integer;
var
  iFileList: TStrings;
  iFileExtension: String;
  iOptionalParams: TStrings;
  iResponseInfo: TCloudResponseInfo;
  iStorageService: TAmazonStorageService;
  iAmazonBucketResult: TAmazonBucketResult;
  iAmazonObjectResult: TAmazonObjectResult;
  iAmazonConnectionInfo: TAmazonConnectionInfo;
begin
  Result := 0;

  iFileExtension := aFileExtension;
  if Pos('.', iFileExtension) = 0 then
    iFileExtension := '.' + iFileExtension;

  try
    iAmazonConnectionInfo := TAmazonConnectionInfo.Create(nil);
    iAmazonConnectionInfo.AccountName := 'AKIA****************';
    iAmazonConnectionInfo.AccountKey  := 'BzNn************************************';

    iOptionalParams := TStringList.Create;
    iOptionalParams.Values['prefix'] := aS3Path;

    iStorageService     := TAmazonStorageService.Create(iAmazonConnectionInfo);
    iResponseInfo       := TCloudResponseInfo.Create;
    iAmazonBucketResult := nil;

    iFileList := TStringList.Create;

    try
      iAmazonBucketResult := iStorageService.GetBucket('our-s3-bucket', iOptionalParams, iResponseInfo);
      for iAmazonObjectResult in iAmazonBucketResult.Objects do
      begin
        if Pos(iFileExtension, iAmazonObjectResult.Name) <> 0 then
          iFileList.Add(iAmazonObjectResult.Name);
      end;

      Result := iFileList.Count;
    except
      on e: Exception do
        ;
    end;
    FreeAndNil(iAmazonBucketResult);
  finally
    iFileList.Free;
    iResponseInfo.Free;
    iStorageService.Free;
    iOptionalParams.Free;
    iAmazonConnectionInfo.Free;
  end;
end;

end.

调用'iStorageService.GetBucket'不会返回任何内容。

0 个答案:

没有答案