mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 18:25:40 +02:00
513 lines
13 KiB
ObjectPascal
513 lines
13 KiB
ObjectPascal
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.
|