unit U_Reserv;

interface

uses
  Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP, idUri, idFTPCommon,idFTPLIST, IdAllFTPListParsers,
  IdFTPListParseBase,IdFTPListParseAS400, IdFTPListParsePcTcp, IdFTPListTypes,
  Wininet, siComp, siLngLnk;


type
  TF_Reserv = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    btnSave: TBitBtn;
    btnLoad: TBitBtn;
    btnDelete: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    lbAllowedSpace: TLabel;
    lbUsedSpace: TLabel;
    siLangLinked1: TsiLangLinked;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnLoadClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function SendFileToFtp(aFtpStr, aFileName: string): boolean;
    function GetFileFromFtp(aFtpStr, aFileNameShort, aFileName: string; aGetConfig: Boolean = false): boolean;
    function GetFileListFromFtp(aFtpStr: string): TStringList;
    function DeleteFileFromFtp(aFtpStr, aFileName: string): boolean;
    Procedure RefreshFileList;
    Procedure SetButtons(aSave, aLoad, aDelete: Boolean);
    Procedure SelectItem;
    Function HexToStr(const HexStr: string): string;
  end;

var
  F_reserv: TF_Reserv;
  Selected_Item: integer;
  FClientLimit: integer; // Лимит клиента на дисковое пространство на серваке, МБ
  FFact: Integer;        // Занято клиентом на сервере, МБ
  //FConnStr: string;

implementation
uses USCS_Main, U_Common, U_BaseCommon, U_BaseConstants;

{$R *.dfm}

function TF_Reserv.HexToStr(const HexStr: string): string;
var
  i: Integer;
begin
  Result := '';
  i := 1;
  while i <= Length(HexStr) do
  begin
    Result := Result + Chr(StrToInt('$' + Copy(HexStr, i, 2)) XOR 57);
    Inc(i, 2);
  end;
end;

Procedure TF_Reserv.SelectItem;
var i: integer;
begin
  if F_Reserv.ListBox1.Count > 0 then
  begin
    for i := 0 to F_Reserv.ListBox1.Count - 1 do
    begin
      if F_Reserv.ListBox1.Selected[i] = true then
        F_Reserv.ListBox1.Selected[i] := False;
    end;

    if Selected_Item > (F_Reserv.ListBox1.Count - 1) then
      Selected_Item := (F_Reserv.ListBox1.Count - 1);

    F_Reserv.ListBox1.Selected[Selected_Item] := true;
  end
  else
    Selected_Item := 0;
end;

Procedure TF_Reserv.SetButtons(aSave, aLoad, aDelete: Boolean);
begin
  F_Reserv.btnSave.Enabled := aSave;
  F_Reserv.btnLoad.Enabled := aLoad;
  F_Reserv.btnDelete.Enabled := aDelete;
end;

Procedure TF_Reserv.RefreshFileList;
var FileList: TStringList;
    i: integer;
    vSave, vLoad, vDelete: Boolean;
    s, tmppath, filename: String;
    f: TextFile;
    UserLimit: integer;
begin
  vSave := False;
  vLoad := False;
  vDelete := False;
  //FConnStr := HexToStr(GFtpConnectStr);
  F_Reserv.ListBox1.Clear;
  tmppath := GetDefaultTempPath;//+'\' + 'USER.CFG';
 { FileList := F_Reserv.GetFileListFromFtp(GFtpConnectStr);
  if FileList <> nil then
  begin
    F_Reserv.ListBox1.Clear;
    for i := 0 to fileList.Count - 1 do // Client Config
    begin
      if UPPERCASE(FileList[i]) = 'USER.CFG' then // файл с объемом выделенного места для пользователя на серваке
      begin
        tmppath := GetDefaultTempPath+'\' + 'USER.CFG';
        if GetFileFromFtp(GFtpConnectStr, 'USER.CFG', tmppath) then  //получить с сервера и прочитать размер доступного места
        begin

        end;
      end;
      //F_Reserv.ListBox1.AddItem(filelist[i], nil);
    end;
    if F_Reserv.ListBox1.Items.Count > 0 then
      SelectItem;
    fileList.Free;
  end;
  }
  FileName := tmppath + 'USER.CFG';
  if fileExists(FileName) then
    DeleteFile(FileNAme);
  if GetFileFromFtp(HexToStr(GFtpConnectStr), 'USER.CFG', tmppath + 'USER.CFG', true) then  //получить с сервера и прочитать размер доступного места
  begin
    AssignFile(f,FileName);
    Reset(f);
    Readln(f,s);
    CloseFile(f);
    UserLimit := strtoint(s);
    lballowedspace.Caption := s;
    vSave := true;
    vLoad := true;
    vDelete := true;
    ////
    FileList := F_Reserv.GetFileListFromFtp(HexToStr(GFtpConnectStr));
    if FileList <> nil then
    begin
      F_Reserv.ListBox1.Clear;
      for i := 0 to fileList.Count - 1 do // Client Config
      begin
        F_Reserv.ListBox1.AddItem(filelist[i], nil);
      end;
      if F_Reserv.ListBox1.Items.Count = 0 then
      begin
        vDelete := False;
        vLoad := False;
      end;
      SelectItem;

      fileList.Free;
      if UserLimit >= strtoint(lbUsedSpace.Caption) then
        vSave := True
      else
        vSave := False;
    end;
  end;
  SetButtons(vSave, vLoad, vDelete);
end;

 function TF_Reserv.SendFileToFtp(aFtpStr, aFileName: string): boolean;
  var NameShort: String;
    Ftp_serv: TIdFtp;
    Uri: TIdURI;
  begin
    Result := False;
    if FileExists(aFileName) then
    begin
      Uri := TIdUri.Create(aFtpStr);
      Ftp_serv:= TIdFtp.create;

      ftp_serv.Host := uri.host;
      ftp_serv.Username := uri.username;
      ftp_serv.Password := uri.password;
      ftp_serv.Port := 21;
      ftp_serv.Passive := true;

      try
        ftp_serv.Connect;
      except
        on E: Exception do
        begin
          //showmessage('Can not to connect!!!');
          ftp_serv.Free;
          URi.Free;
          AddExceptionToLog(cFtpmes1, true);
          exit;
        end;
      end;

      if ftp_serv.Connected then
      begin
        NameShort := ExtractFileName(aFileName);
        try
          ftp_serv.Put(aFileName, NameShort);
          Result := True;
        except
          on E: exception do
          begin
            Result := False;
            AddExceptionToLog(cFtpmes2, true);
             //showMessage('Can not to send a file!');
          end;
        end;
      end;
      ftp_serv.Disconnect;
      ftp_serv.Free;
      URi.Free;
    end;
  end;

  function TF_Reserv.GetFileFromFtp(aFtpStr, aFileNameShort, aFileName: string; aGetConfig: Boolean = false): boolean;
  var
    Ftp_serv: TIdFtp;
    Uri: TIdURI;
  begin
    Result := false;

    Uri := TIdUri.Create(aFtpStr);
    Ftp_serv:= TIdFtp.create;

    ftp_serv.Host := uri.host;
    ftp_serv.Username := uri.username;
    ftp_serv.Password := uri.password;
    ftp_serv.Port := 21;
    ftp_serv.Passive := true;

    try
      ftp_serv.Connect;
    except
      on E: Exception do
      begin
        //showmessage('Can not to connect!!!');
        Result := false;
        ftp_serv.Free;
        URi.Free;
        AddExceptionToLog(cFtpmes1, true);
        exit;
      end;
    end;

    if ftp_serv.Connected then
    begin
      if aGetConfig then
      begin
        try
          ftp_serv.ChangeDir('cfg');
          ftp_serv.get(aFileNameShort, aFileName);
          Result := True;
        except
          on E: exception do
          begin
             //showMessage('Can not to get file from ftp!');
            AddExceptionToLog(cFtpmes6, true);
            Result := False;
          end;
        end;
      end
      else
      begin
        try
          ftp_serv.ChangeDir('/');
          ftp_serv.get(aFileNameShort, aFileName);
          Result := True;
        except
          on E: exception do
          begin
             //showMessage('Can not to get file from ftp!');
            AddExceptionToLog(cFtpmes3, true);
            Result := False;
          end;
        end;
      end;
    end;
    ftp_serv.Disconnect;
    ftp_serv.Free;
    URi.Free;
  end;

  function TF_Reserv.GetFileListFromFtp(aFtpStr: string): TStringList;
  var
    Ftp_serv: TIdFtp;
    Uri: TIdURI;
    Size: Double;
    i, rsize: integer;
  begin
    Result := TstringList.Create;
    rsize := 0;
    Uri := TIdUri.Create(aFtpStr);
    Ftp_serv:= TIdFtp.create;

    ftp_serv.Host := uri.host;
    ftp_serv.Username := uri.username;
    ftp_serv.Password := uri.password;
    ftp_serv.Port := 21;
    ftp_serv.Passive := true;

    try
      ftp_serv.Connect;
    except
      on E: Exception do
      begin
        //showmessage('Can not to connect!!!');
        ftp_serv.Free;
        URi.Free;
        FreeAndNil(Result);
        AddExceptionToLog(cFtpmes1, true);
        exit;
      end;
    end;

    if ftp_serv.Connected then
    begin
      try
        //ftp_serv.List(Result,'*.*',false);
        ftp_serv.ChangeDirUp;
        ftp_serv.List(Result,'*.scs', false);
        Size := 0;
        for i := 0 to ftp_serv.DirectoryListing.Count - 1 do
        begin
          Size := Size + ftp_serv.Size(ftp_serv.DirectoryListing[i].FileName);
        end;
        rsize := round(size/1048576);
        lbUsedSpace.Caption := inttostr(rsize);
        if rsize >= strtoint(lballowedspace.Caption) then
          lbUsedSpace.Font.Color := clRed
        else
          lbUsedSpace.Font.Color := clBlue;
        //ftp_serv.List(Result,'', false);
      except
        on E: exception do
        begin
          //showmessage('Can not get filelist from FTP!');
          FreeAndNil(Result);
          AddExceptionToLog(cFtpmes5, true);
        end;
      end;
    end;
    ftp_serv.Disconnect;
    ftp_serv.Free;
    URi.Free;
  end;

  function TF_Reserv.DeleteFileFromFtp(aFtpStr, aFileName: string): boolean;
  var
    Ftp_serv: TIdFtp;
    Uri: TIdURI;
  begin
    Result := False;

    Uri := TIdUri.Create(aFtpStr);
    Ftp_serv:= TIdFtp.create;

    ftp_serv.Host := uri.host;
    ftp_serv.Username := uri.username;
    ftp_serv.Password := uri.password;
    ftp_serv.Port := 21;
    ftp_serv.Passive := true;

    try
      ftp_serv.Connect;
    except
      on E: Exception do
      begin
        //showmessage('Can not to connect!!!');
        ftp_serv.Free;
        URi.Free;
        AddExceptionToLog(cFtpmes1, true);
        exit;
      end;
    end;

    if ftp_serv.Connected then
    begin
      try
        ftp_serv.Delete(aFileName);
        Result := True;
      except
        on E: exception do
        begin
          Result := False;
          //showMessage('Can not to send a file!');
          AddExceptionToLog(cFtpmes4, true);
        end;
      end;
    end;
    ftp_serv.Disconnect;
    ftp_serv.Free;
    URi.Free;
  end;


procedure TF_Reserv.btnDeleteClick(Sender: TObject);
var i: integer;
begin
  if ListBox1.Count > 0 then
  begin
    for i := 0 to ListBox1.Count - 1 do
    begin
      if ListBox1.Selected[i] = true then
      begin
        Selected_Item := i;
        if DeleteFileFromFtp(HexToStr(GFtpConnectStr), ListBox1.Items[i]) then
        begin
          RefreshFileList;
        end;
        break;
      end;
    end;
  end;
end;

procedure TF_Reserv.btnLoadClick(Sender: TObject);
var SaveDlg: TSaveDialog;
    FileName: string;
    i: integer;
begin
  FileName := '';
  for i := 0 to ListBox1.Count - 1 do
  begin
    if ListBox1.Selected[i] = true then
    begin
      FileName := ListBox1.Items[i];
      break;
    end;
  end;
  if fileName <> '' then
  begin
    SaveDlg := TSaveDialog.Create(nil);
    SaveDlg.Filter := ' (*.scs)|*.SCS';
    SaveDlg.FileName := fileName;
    if SaveDlg.Execute then
    begin
      FileName := SaveDlg.FileName;
      GetFileFromFtp(HexToStr(GFtpConnectStr), extractfilename(FileName), SaveDlg.FileName);
    end;
    SaveDlg.Free;
  end;
end;

procedure TF_Reserv.btnSaveClick(Sender: TObject);
var OpenDlg: TOpenDialog;
   FileNameShort, Filename: string;
   i: integer;

begin
  for i := 0 to ListBox1.Count - 1 do
  begin
    if ListBox1.Selected[i] = true then
    begin
      Selected_Item := i;
      break;
    end;
  end;
  OpenDlg := TOpenDialog.Create(nil);
  OpenDlg.Filter := ' (*.scs)|*.SCS';
  if OpenDlg.Execute then
  begin
    FileName := OpenDlg.FileName;
    //FileNameShort := ExtractFileName(OpenDlg.FileName);
    if SendFileToFtp(HexToStr(GFtpConnectStr), FileName) then
      RefreshFileList;
  end;
  OpenDlg.Free;
end;

procedure TF_Reserv.Button1Click(Sender: TObject);
begin
  F_Reserv.Close;
end;

procedure TF_Reserv.FormCreate(Sender: TObject);
begin
  {
  btnSave.Caption := 'Загрузить файл' + #13#10 + '   на сервер';
  btnLoad.Caption := 'Загрузить файл' + #13#10 + '   с сервера';
  btnDelete.Caption := 'Удалить файл' + #13#10 + '   на сервере';
  }
  btnSave.Caption := cFtpbtnSaveCaption;
  btnLoad.Caption := cFtpbtnLoadCaption;
  btnDelete.Caption := cFtpbtnDeleteCaption;

  Selected_Item := 0;
  FClientLimit := 0;
  FFact := 0;
  lballowedspace.Font.Color := clBlue;
  lbUsedSpace.Font.Color := clBlue;
end;

procedure TF_Reserv.FormShow(Sender: TObject);
var FileList: TStringList;
    i: integer;
begin
  RefreshFileList;
  //SelectItem;
end;


end.