serverservice_impl.pas

著名的SecureBlackBox控件完整源码

unit ServerService_Impl;

interface

uses Classes, SysUtils, IdGlobal, uROTypes,
  uROClientIntf, uROServer, uROServerIntf, ServerLibrary_Intf;

type
  TServerService = class(TRORemotable, IServerService)
  private
  protected
    function GetServerTime: DateTime;
    function UploadAFile(const FileName: string; const FileBin: Binary):
      Boolean;
    function DownloadAFile(const FileName: string; out FileBin: Binary):
      Boolean;
  end;

implementation

uses ServerLibrary_Invk, uMainServer;

procedure Create_ServerService(out anInstance: IUnknown);
begin
  anInstance := TServerService.Create;
end;

function TServerService.GetServerTime: DateTime;
begin
  result := now;
end;

function TServerService.DownloadAFile(const FileName: string;
  out FileBin: Binary): Boolean;
var
  LocalFileName: String;
begin
  result := false;
  FileBin := Binary.Create;
  try
    LocalFileName := IncludeTrailingBackslash(frmMainServer.eUploadDir.Text)+FileName;
    if FileExists(LocalFileName) then
    begin
      FileBin.LoadFromFile(LocalFileName);
      result := true;
    end;
  except
    on e: exception do
    begin
      result := false;
    end;
  end;
end;

function TServerService.UploadAFile(const FileName: string;
  const FileBin: Binary): Boolean;
begin
  result := false;
  with frmMainServer do try
    if not DirectoryExists(eUploadDir.Text)
        then CreateDir(eUploadDir.Text);

    FileBin.SaveToFile(IncludeTrailingBackslash(eUploadDir.Text)+ExtractFileName(FileName));
    result := true;
  except
    on e: exception do
    begin
      result := false;
    end;
  end;
end;

initialization
  TROClassFactory.Create('ServerService', Create_ServerService,
    TServerService_Invoker);

finalization

end.