Componentes.Terceros.RemObjects/internal/6.0.43.801/1/RemObjects Samples/RemObjects SDK for Delphi/Extended File Transfer/fClientForm.pas

unit fClientForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  uROClient, uROClientIntf, uRORemoteService, uROBinMessage, uROWinInetHTTPChannel,
  uROPoweredByRemObjectsButton, ExtCtrls, ComCtrls, Mask, uROTypes;

type
  TClientForm = class(TForm)
    ROMessage: TROBinMessage;
    ROChannel: TROWinInetHTTPChannel;
    RORemoteService: TRORemoteService;
    Panel1: TPanel;
    Panel2: TPanel;
    ROPoweredByRemObjectsButton1: TROPoweredByRemObjectsButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    edTargetURL: TEdit;
    btGetList: TButton;
    Panel3: TPanel;
    GroupBox2: TGroupBox;
    Label2: TLabel;
    cbChunkSize: TComboBox;
    Label3: TLabel;
    edChunkCount: TEdit;
    Label4: TLabel;
    edThreadCount: TMaskEdit;
    GroupBox3: TGroupBox;
    lvFileList: TListView;
    GroupBox4: TGroupBox;
    edLog: TMemo;
    btDownload: TButton;
    procedure btGetListClick(Sender: TObject);
    procedure lvFileListChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure cbChunkSizeChange(Sender: TObject);
    procedure btDownloadClick(Sender: TObject);
  private
    { Private declarations }
    fOutFile: TFileStream;
    procedure CalcChunkCount;
    function GetPartSize: integer;
    procedure SetControlsEnabled(aState: boolean);
  public
    { Public declarations }
    procedure LogMessage(msg: string);
    procedure WriteChunk(aChunkNo: integer; aChunkSize: integer; aData: Binary);
  end;

var
  ClientForm: TClientForm;

implementation

uses ExtendedFileTransferLibrary_Intf, uROClasses, DownloadThread;

{$R *.dfm}

procedure TClientForm.btDownloadClick(Sender: TObject);
var
  threads: array of TDownloadThread;
  numThreads: integer;
  i: integer;
  curChunk: integer;
  chunkCount: integer;
  allDone: boolean;
begin
  if not Assigned(lvFileList.Selected) then ShowMessage('Please select a file!')
  else begin
    edLog.Lines.Clear;
    fOutFile := TFileStream.Create(lvFileList.Selected.Caption, fmCreate);
    try
      chunkCount := StrToInt(edChunkCount.Text);
      numThreads := StrToInt(Trim(edThreadCount.Text));
      if numThreads <= 0 then numThreads := 1;
      SetLength(threads, numThreads);
      curChunk := 1;

      LogMessage('Starting download process...');
      SetControlsEnabled(false);

      for i := 0 to numThreads - 1 do begin
        if curChunk <= chunkCount then begin
          threads[i] := TDownloadThread.Create(i + 1, lvFileList.Selected.Caption,
            curChunk, GetPartSize, edTargetURL.Text);
          inc(curChunk);
          threads[i].Resume;
        end
        else threads[i] := nil;
      end;

      // Loading chunks using available threads in the pool
      while curChunk <= chunkCount do begin
        for i := 0 to numThreads - 1 do
          if Assigned(threads[i]) and threads[i].Done then begin
            threads[i].Free;
            threads[i] := nil;
            if curChunk <= chunkCount then begin
              threads[i] := TDownloadThread.Create(i + 1, lvFileList.Selected.Caption,
                curChunk, GetPartSize, edTargetURL.Text);
              inc(curChunk);
              threads[i].Resume;
            end;
          end;
        if curChunk <= chunkCount then Application.ProcessMessages;
      end;

      // Waiting for all threads to finish
      repeat
        allDone := true;
        for i := 0 to numThreads - 1 do
          if Assigned(threads[i]) then begin
            if threads[i].Done then begin
              threads[i].Free;
              threads[i] := nil;
            end
            else allDone := false;
          end;
        if not allDone then Application.ProcessMessages;
      until allDone;
    finally
      fOutFile.Free;
      LogMessage('Download complete!');
      SetControlsEnabled(true);
    end;
  end;
end;

procedure TClientForm.btGetListClick(Sender: TObject);
var
  files: FileInfoArray;
  i: integer;
  item: TListItem;
begin
  ROChannel.TargetURL := edTargetURL.Text;
  files := nil;
  lvFileList.Items.BeginUpdate;
  try
    lvFileList.Items.Clear;
    files := (RORemoteService as IExtendedFileTransferService).GetFilesList;
    for i := 0 to files.Count - 1 do begin
      item := lvFileList.Items.Add;
      item.Caption := {$IFDEF UNICODE}AnsiStringToWideString{$ENDIF}(files.Items[i].FileName);
      item.SubItems.Append(IntToStr(files.Items[i].Size));
      item.SubItems.Append({$IFDEF UNICODE}AnsiStringToWideString{$ENDIF}(files.Items[i].TypeName));
    end;
    if lvFileList.Items.Count > 0 then begin
      lvFileList.Selected := lvFileList.Items[0];
      lvFileList.SetFocus;
    end;
  finally
    if Assigned(files) then files.Free;
        lvFileList.Items.EndUpdate;
  end;
end;

procedure TClientForm.CalcChunkCount;
var
  size: integer;
  chunk: integer;
begin
  if Assigned(lvFileList.Selected) then begin
    size := StrToInt(lvFileList.Selected.SubItems[0]);
    chunk := GetPartSize;
    if chunk <> 0 then begin
      if size mod chunk > 0 then edChunkCount.Text := IntToStr((size div chunk) + 1)
      else edChunkCount.Text := IntToStr(size div chunk);
    end
    else edChunkCount.Text := 'Error!';
  end;
end;

procedure TClientForm.cbChunkSizeChange(Sender: TObject);
begin
  CalcChunkCount;
end;

function TClientForm.GetPartSize: integer;
begin
    case cbChunkSize.ItemIndex of
      0: Result := 500;
      1: Result := 64 * 1024;
      2: Result := 128 * 1024;
      3: Result := 512 * 1024;
      4: Result := 1 * 1024 * 1024;
      5: Result := 2 * 1024 * 1024;
      6: Result := 3 * 1024 * 1024;
      else Result := 0;
    end;
end;

procedure TClientForm.LogMessage(msg: string);
begin
  edLog.Lines.Append(msg);
end;

procedure TClientForm.lvFileListChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  CalcChunkCount;
end;

procedure TClientForm.SetControlsEnabled(aState: boolean);
begin
  cbChunkSize.Enabled := aState;
  edThreadCount.Enabled := aState;
  btDownload.Enabled := aState;
  edTargetURL.Enabled := aState;
end;

procedure TClientForm.WriteChunk(aChunkNo, aChunkSize: integer; aData: Binary);
var
  lOffset: integer;
begin
  lOffset := aChunkSize * (aChunkNo -  1);
  fOutFile.Seek(lOffset, soFromBeginning);
  fOutFile.CopyFrom(aData, aData.Size)
end;

end.