expertcad/SRC/Main/U_Reserv.pas

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, Grids, DBGrids, RzDBGrid, DB, SQLMemMain,
  cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxStyles,
  cxCustomData, cxFilter, cxData, cxDataStorage, cxEdit, cxNavigator, cxDBData,
  cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
  cxClasses, cxGridCustomView, cxGrid, ExtCtrls, RzPanel, ActnList,
  PlatformDefaultStyleActnCtrls, ActnMan, ToolWin, ActnCtrls, ComCtrls, acDBGrid,
  Menus, kbmMemTable, kbmMemSQL, DBTables;


type
  TF_Reserv = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    lbAllowedSpace: TLabel;
    lbUsedSpace: TLabel;
    siLangLinked1: TsiLangLinked;
    DataSource1: TDataSource;
    FileTable: TSQLMemTable;
    FileTableFileSize: TStringField;
    FileTableFileDate: TStringField;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ActionList1: TActionList;
    aRefresh: TAction;
    aUpload: TAction;
    aLoad: TAction;
    aDelFileFrom: TAction;
    aExit: TAction;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    aDelete1: TMenuItem;
    FileTable1: TkbmMemTable;
    aToPM: TAction;
    aFromPM: TAction;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    FileTableFileName: TStringField;
    Query1: TQuery;
    FileTable1FileName: TStringField;
    FileTable1FileSize: TStringField;
    FileTable1FileData: TStringField;
    MemSQL1: TkbmMemSQL;
    cxGrid1DBTableView1: TcxGridDBTableView;
    cxGrid1Level1: TcxGridLevel;
    cxGrid1: TcxGrid;
    cxGrid1DBTableView1FileName: TcxGridDBColumn;
    cxGrid1DBTableView1FileSize: TcxGridDBColumn;
    cxGrid1DBTableView1FileDate: TcxGridDBColumn;
    //procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    //procedure btnSaveClick(Sender: TObject);
    //procedure btnLoadClick(Sender: TObject);
    //procedure btnDeleteClick(Sender: TObject);
    procedure aRefreshExecute(Sender: TObject);
    procedure aUploadExecute(Sender: TObject);
    procedure aExitExecute(Sender: TObject);
    procedure aLoadExecute(Sender: TObject);
    procedure aDelFileFromExecute(Sender: TObject);
    procedure aToPMExecute(Sender: TObject);
    procedure aFromPMExecute(Sender: TObject);
    //procedure RzDBGrid1TitleClick(Column: TColumn);
  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;
    function SaveCurrProjToTemFile: boolean;
    //function GetTempDir: string;
  end;

var
  F_reserv: TF_Reserv;
  Selected_Item: integer;
  FClientLimit: integer; // <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><>
  FFact: Integer;        // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><>
  FileDateList: TStringList;
  FileSizeList: TStringList;
  MyHeaderStyle: TcxStyle;
  //FConnStr: string;

implementation
uses USCS_Main, U_Common, U_BaseCommon, U_BaseConstants, U_ProtectionCommon, U_Main, U_SCSComponent;

{$R *.dfm}

(*
function GetTempDir: string;
var
  buff: pchar;
  s: string;
begin
  if length(TempDir) > 0 then
  begin
    if DirectoryExists(TempDir) then
      Result := TempDir
    else
    begin
      TempDir := '';
      Result := GetTempDir;
    end;
  end
  else
  begin
    // Tolik 24/06/* 2019 --
    s := GetEnvironmentVariable('tmp');

    if ((s = '') or (not DirectoryExists(s))) then
      s := GetEnvironmentVariable('temp');

    if ((s = '') or (not DirectoryExists(s))) then
      s := exedir;

    (*
    // Tolik 21/06/2019 --
    getmem(buff, 256*2);
    //
    s := '';
    if (GetEnvironmentVariable('tmp',buff, 254) >0)
      and (DirectoryExists(buff)) then
    begin
      s := buff;
    end
    else
    if (GetEnvironmentVariable('temp',buff, 254) >0)
      and (DirectoryExists(buff)) then
    begin
      s := buff;
    end
    else
      s := exedir;
    freemem(buff);
    *)
  (*  try
      if not DirectoryExists(s + OurTempDir) then
        MkDir(s + OurTempDir);
      TempDir := s + OurTempDir;
      result := TempDir;
    except
      ShowMessage(cTmpDirErr);
      {$if Defined(ES_GRAPH_SC)}
        Application.Terminate;
      {$else}
        ExitProcess(1);
      {$ifend}
    end;
  end;
end;
*)
function TF_Reserv.SaveCurrProjToTemFile: boolean;
var TempProj: TSCSProject;
    CurrProjNode: TTreeNode;
begin
  CurrProjNode :=  F_ProjMan.GSCSBase.CurrProject.TreeViewNode;
  Result := false;

end;

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.aUploadExecute(Sender: TObject);
var OpenDlg: TOpenDialog;
   FileNameShort, Filename: string;
   i: integer;

begin
  OpenDlg := TOpenDialog.Create(nil);
  OpenDlg.Filter := ' (*.scs)|*.SCS';
  if OpenDlg.Execute then
  begin
    FileName := OpenDlg.FileName;
    if SendFileToFtp(HexToStr(GFtpConnectStr), FileName) then
      RefreshFileList;
  end;
  OpenDlg.Free;
end;

procedure TF_Reserv.aDelFileFromExecute(Sender: TObject);
begin
   if DeleteFileFromFtp(HexToStr(GFtpConnectStr), f_Reserv.filetable.fieldvalues['filename']) then
   begin
     RefreshFileList;
   end;
end;

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

procedure TF_Reserv.aFromPMExecute(Sender: TObject);
var tdir: string;
    canProceed, formHide: Boolean;
    fName: String;
begin
  if CheckIsOpenProject(false) then
  begin
    tdir := '';
    tdir := GetTempDir;
    if tdir <> '' then
    begin
     FName := tdir + '\'+ F_ProjMan.GSCSBase.CurrProject.Name + '.scs';
     if FileExists(FName) then
       DeleteFile(FName);
     if F_ProjMan.GSCSBase.CurrProject.SaveToStreamOrFile(nil, FName) then
     begin
       if SendFileToFtp(HexToStr(GFtpConnectStr), FName) then
         RefreshFileList;
     end;

     if FileExists(FName) then
       DeleteFile(FName);
    end;
  end
  else
    ShowMessage('');
end;

procedure TF_Reserv.aLoadExecute(Sender: TObject);
var SaveDlg: TSaveDialog;
    FileName: string;
    i: integer;
begin
  FileName := '';
  FileName := FileTable.fieldvalues['FileName'];
  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.aRefreshExecute(Sender: TObject);
begin
  RefreshFileList;
end;

procedure TF_Reserv.aToPMExecute(Sender: TObject);
var tdir: string;
    canProceed, formHide: Boolean;
begin
  tdir := '';
  tdir := GetTempDir;
  if tdir <> '' then
  begin
    CanProceed := False;
    formHide := False;
    if CheckIsOpenProject(false) then
    begin
      if MessageBox(F_Reserv.Handle, PChar(cFtpmes7), PChar(cWarningSlowCap), MB_YESNO) = IDYes then
      begin
        F_Reserv.Hide;
        formHide := True;
        CanProceed :=  CloseCurrProject(true) <> IDCancel;
      end;
    end
    else
      CanProceed := True;

    if CanProceed then
    begin
      GetFileFromFtp(HexToStr(GFtpConnectStr), FileTable.FieldValues['FileName'], tdir + '\'+ FileTable.FieldValues['FileName']);
      if FileExists(tdir + '\'+ FileTable.FieldValues['FileName']) then
      begin
        F_ProjMan.LoadProjectFromFile(tdir + '\'+ FileTable.FieldValues['FileName']);
        DeleteFile(tdir + '\'+ FileTable.FieldValues['FileName']);
        F_Reserv.Close;
      end;
    end
    else
    begin
      if formHide then
        F_Reserv.ShowModal;
    end;
  end;
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;
  f_Reserv.FileTable.Close;
  f_Reserv.FileTable.Open;

  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 // <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
      begin
        tmppath := GetDefaultTempPath+'\' + 'USER.CFG';
        if GetFileFromFtp(GFtpConnectStr, 'USER.CFG', tmppath) then  //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
        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  //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
  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
      //FileTable.ReadOnly := False;
      // F_Reserv.FileTable.EmptyTable;
      While F_Reserv.FileTable.RecordCount > 0 do
      begin
        F_Reserv.FileTable.Delete;
      end;
      //F_Reserv.ListBox1.Clear;
      for i := 0 to fileList.Count - 1 do // Client Config
      begin
        //F_Reserv.ListBox1.AddItem(filelist[i], nil);
        F_Reserv.FileTable.Append;
        F_Reserv.FileTable.FieldByName('FileName').AsString := FileList[i];
        F_Reserv.FileTable.FieldByName('FileDate').AsString := FileDateList[i];
        F_Reserv.FileTable.FieldByName('FileSize').AsString := FileSizeList[i];
      end;
      //FileTable.ReadOnly := True;
      //if F_Reserv.ListBox1.Items.Count = 0 then
      F_Reserv.aDelFileFrom.Enabled := True;
      F_Reserv.aLoad.Enabled := True;
      F_Reserv.aToPM.Enabled := True;

      if F_Reserv.FileTable.RecordCount = 0 then
      begin
        F_Reserv.aDelFileFrom.Enabled := False;
        F_Reserv.aLoad.Enabled := False;
        F_Reserv.aToPM.Enabled := False;
      end
      else
      begin
        F_Reserv.FileTable.First;
        F_Reserv.cxGrid1DBTableView1.Controller.FocusedRowIndex := 0;
      end;
      //F_Reserv.FileTable.First;
      //SelectItem;

      fileList.Free;
      if UserLimit <= strtoint(lbUsedSpace.Caption) then
      begin
        F_Reserv.aUpload.Enabled := False;
        F_Reserv.aFromPM.Enabled := False;
      end
      else
      begin
        F_Reserv.aUpload.Enabled := True;
        //F_Reserv.aFromPM.Enabled := True;
        if CheckIsOpenProject(false) then
          F_Reserv.aFromPM.Enabled := True
        else
          F_Reserv.aFromPM.Enabled := False;
      end;
    end
    else
    begin
      F_Reserv.aDelFileFrom.Enabled := False;
      F_Reserv.aLoad.Enabled := False;
      F_Reserv.aToPM.Enabled := False;
      F_Reserv.aUpload.Enabled := False;
      F_Reserv.aFromPM.Enabled := False;
      Showmessage('cFtpmes12');
    end;
  end
  else
  begin
    F_Reserv.aDelFileFrom.Enabled := False;
    F_Reserv.aLoad.Enabled := False;
    F_Reserv.aToPM.Enabled := False;
    F_Reserv.aUpload.Enabled := False;
    F_Reserv.aFromPM.Enabled := False;
    Showmessage('cFtpmes12');
  end;
  //SetButtons(vSave, vLoad, vDelete);
end;
{
procedure TF_Reserv.RzDBGrid1TitleClick(Column: TColumn);
var FldName: string;
begin
  FldName := Column.FieldName;
  FileTable.IndexName := 'Filename';
end;
}
function TF_Reserv.SendFileToFtp(aFtpStr, aFileName: string): boolean;
  var NameShort, NewName: String;
    Ftp_serv: TIdFtp;
    Uri: TIdURI;
    bm: TBookmark;
    FileNameExists: Boolean;
    i: integer;
  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;
      ftp_serv.TransferType := ftBinary;
      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);

        if F_Reserv.FileTable.RecordCount > 0 then    //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
        begin
          FileNameExists := false;
          bm := F_Reserv.FileTable.Bookmark;
          F_Reserv.FileTable.DisableControls;
          F_Reserv.FileTable.First;

          while not F_Reserv.FileTable.Eof do
          begin
            if NameShort = F_Reserv.FileTable.FieldValues['FileName'] then
            begin
              FileNameExists := true;
              break;
            end;
            F_Reserv.FileTable.Next;
          end;

          F_Reserv.FileTable.Bookmark := bm;
          F_Reserv.FileTable.EnableControls;
        end;

        if FileNameExists then // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
        begin                  // <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
          if MessageBox(F_Reserv.Handle, PChar(cFtpmes8), PChar(cWarningSlowCap), MB_YESNO) <> IDYes then
          begin
            NameShort :=  Trim(InputBox(cFtpmes9, cFtpmes10, ''));
            if length(NameShort) > 0 then
            begin
              NewName := '';
              for i := 1 to Length(NameShort) do
              begin
                if NameShort[i] = '.' then
                  break
                else
                  NewName := NewName + NameShort[i];
              end;
              if NewName <> '' then
                NameShort := NewName + '.scs'
              else
              begin
                ShowMessage(cFtpmes11);
                ftp_serv.Disconnect;
                ftp_serv.Free;
                URi.Free;
                exit;
              end;
            end;
          end
          else
            DeleteFileFromFtp(aFtpStr, aFileName);  //<2F><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
        end;

        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;
    ftp_serv.TransferType := ftBinary;

    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, FileSize: 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
          FileSize := ftp_serv.Size(ftp_serv.DirectoryListing[i].FileName);
          Size := Size + FileSize;
          FileDateList.Add(DateTostr(ftp_serv.FileDate(ftp_serv.DirectoryListing[i].FileName)));
          FileSizeList.Add(FloatToStr(RoundX(FileSize/1048576, 3)));
        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
  i := f_Reserv.RzDBGrid1.SelectedIndex;
  i := 0;
  {
  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
  FileDateList := TStringList.Create;
  FileSizeList := TStringList.Create;
  {
  btnSave.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>' + #13#10 + '   <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
  btnLoad.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>' + #13#10 + '   <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
  btnDelete.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>' + #13#10 + '   <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
  }
  {btnSave.Caption := cFtpbtnSaveCaption;
  btnLoad.Caption := cFtpbtnLoadCaption;
  btnDelete.Caption := cFtpbtnDeleteCaption;}

  Selected_Item := 0;
  FClientLimit := 0;
  FFact := 0;
  lballowedspace.Font.Color := clBlue;
  lbUsedSpace.Font.Color := clBlue;
  MyHeaderStyle := TcxStyle.Create(nil);
  MyHeaderStyle.Font.Style := [fsBold];
  cxGrid1DBTableView1.Styles.Header := MyHeaderStyle;
end;

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