Мегаобучалка Главная | О нас | Обратная связь


Листинг серверной части приложения



2016-01-05 440 Обсуждений (0)
Листинг серверной части приложения 0.00 из 5.00 0 оценок




unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, UnitServerTrsFl, ExtCtrls, ExtDlgs, Gauges, ComCtrls,

Spin;

Type

TForm1 = class(TForm)

PanelConnect: TPanel;

ButtonOpen: TButton;

EditPortTCP: TEdit;

EditPortUDP: TEdit;

LabelPortTCP: TLabel;

LabelPortUdp: TLabel;

LabelDossier: TLabel;

EditDossier: TEdit;

ButtonChgDs: TButton;

SaveDialog1: TSaveDialog;

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure ButtonOpenClick(Sender: TObject);

procedure ServerTrsFl1Connect(Sender: TObject);

procedure ServerTrsFl1Disconnect(Sender: TObject);

procedure ServerTrsFl1NouveauFichier(Sender: TObject; var accepter: boolean; Nom: string; Size: int64;

NumConnection: integer);

procedure ServerTrsFl1Evolution(Sender: TObject; Maximum,Evolution: integer; NumConnection: integer);

procedure ServerTrsFl1Fini(Sender: TObject; Chemin: string; NumConnection: integer);

procedure ServerTrsFl1Erreur(Sender: TObject; TransfertAnnuler: boolean; ErreurText: string;

NumConnection: integer);

procedure ButtonGrpBox(Sender: TObject);

procedure ButtonChgDsClick(Sender: TObject);

procedure FormCanResize(Sender: TObject; var NewWidth,

NewHeight: Integer; var Resize: Boolean);

private

public

end;

var

Form1: TForm1;

ServerTrsFl1: TServerTrsFl;

ListComposants: TStringList;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

EditDossier.Text:=ExtractFilePath(Application.ExeName);

ListComposants:=TStringList.Create;

ServerTrsFl1:=TServerTrsFl.Create(Self);

ServerTrsFl1.OnConnect:=ServerTrsFl1Connect;

ServerTrsFl1.OnDisconnect:=ServerTrsFl1Disconnect;

ServerTrsFl1.OnNouveauFichierEvent:=ServerTrsFl1NouveauFichier;

ServerTrsFl1.OnEvolutionEvent:=ServerTrsFl1Evolution;

ServerTrsFl1.OnFiniEvent:=ServerTrsFl1Fini;

ServerTrsFl1.OnErreurEvent:=ServerTrsFl1Erreur;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

var

i: integer;

begin

ServerTrsFl1.Open();

ServerTrsFl1.close;

for i:=ListComposants.Count-1 downto 0 do

begin

if not(ListComposants.Objects[i]=nil)

then ListComposants.Objects[i].Free;

end;

ServerTrsFl1.Free;

ListComposants.Free;

end;

procedure TForm1.ServerTrsFl1Connect(Sender: TObject);

begin

EditPortTCP.Enabled:=false;

EditPortUDP.Enabled:=false;

EditDossier.Enabled:=false;

ButtonChgDs.Enabled:=false;

ButtonOpen.Caption:='Выключить сервер';

end;

procedure TForm1.ServerTrsFl1Disconnect(Sender: TObject);

begin

EditPortTCP.Enabled:=true;

EditPortUDP.Enabled:=true;

EditDossier.Enabled:=true;

ButtonChgDs.Enabled:=true;

ButtonOpen.Caption:='Запустить сервер';

end;

procedure TForm1.ServerTrsFl1NouveauFichier(Sender: TObject; var accepter: boolean; Nom: string; Size:

int64; NumConnection: integer);

var

Gauge: TGauge;

Button: TButton;

LabelEv: TLabel;

GroupBox: TGroupBox;

begin

accepter:=true;

GroupBox:=TGroupBox.Create(Form1);

Button:=TButton.Create(Form1);

Button.Parent:=GroupBox;

Gauge:=TGauge.Create(Form1);

Gauge.Parent:=GroupBox;

LabelEv:=TLabel.Create(Form1);

LabelEv.Parent:=GroupBox;

GroupBox.Caption:=Nom+' - '+inttostr(Size) +' Байт';

GroupBox.Left:=0;

Button.Left:=8;

Button.Top:=40;

Button.Caption:='Cancel';

LabelEv.Left:=88;

LabelEv.Top:=48;

LabelEv.Caption:='';

LabelEv.Hint:='';

Gauge.Height:=20;

Gauge.MinValue:=0;

Gauge.Progress:=0;

GroupBox.Height:=72;

GroupBox.Top:=999999999;

GroupBox.Align:=alTop;

Gauge.Align:=alTop;

GroupBox.Parent := Form1;

GroupBox.Tag:=NumConnection;

Button.Tag:=NumConnection;

Button.OnClick:=ButtonGrpBox;

Gauge.Tag:=NumConnection;

LabelEv.Tag:=NumConnection;

ListComposants.AddObject('GrpBox_'+inttostr(NumConnection),GroupBox);

ListComposants.AddObject('Btn_'+inttostr(NumConnection),Button);

ListComposants.AddObject('Gauge_'+inttostr(NumConnection),Gauge);

ListComposants.AddObject('Label_'+inttostr(NumConnection),LabelEv);

Application.ProcessMessages;

end;

procedure TForm1.ServerTrsFl1Evolution(Sender: TObject; Maximum,Evolution: integer;

NumConnection: integer);

Var

i: integer;

begin

i:=ListComposants.IndexOf('Gauge_'+inttostr(NumConnection));

if not (i=-1)

then

begin

(ListComposants.Objects[i] as TGauge).MaxValue:=Maximum;

(ListComposants.Objects[i] as TGauge).Progress:=Evolution;

end;

i:=ListComposants.IndexOf('Label_'+inttostr(NumConnection));

if not (i=-1)

then (ListComposants.Objects[i] as TLabel).Caption:=inttostr(Evolution)+'/'+inttostr(Maximum);

end;

procedure TForm1.ServerTrsFl1Fini(Sender: TObject; Chemin: string; NumConnection: integer);

var

i: integer;

begin

i:=ListComposants.IndexOf('Btn_'+inttostr(NumConnection));

if not(i=-1)

then (ListComposants.Objects[i] as TButton).Caption:='Закрыть';

i:=ListComposants.IndexOf('Label_'+inttostr(NumConnection));

if not(i=-1)

then

begin

(ListComposants.Objects[i] as TLabel).Caption:='Файл сохранён: '+Chemin;

(ListComposants.Objects[i] as TLabel).Hint:=ExtractFileName(Chemin);

end;

end;

procedure TForm1.ServerTrsFl1Erreur(Sender: TObject; TransfertAnnuler: boolean; ErreurText:

string;

NumConnection: integer);

Var

i: integer;

begin

if TransfertAnnuler

then

begin

i:=ListComposants.IndexOf('Btn_'+inttostr(NumConnection));

if not(i=-1)

then (ListComposants.Objects[i] as TButton).Caption:='Cancel';

end;

i:=ListComposants.IndexOf('Label_'+inttostr(NumConnection));

if not (i=-1)

then (ListComposants.Objects[i] as TLabel).Caption:='Error: '+ErreurText;

end;

procedure TForm1.ButtonGrpBox(Sender: TObject);

var

s: string;

NumConnection,i: integer;

Begin

NumConnection:=(Sender as TButton).Tag;

i:=ListComposants.IndexOf('Btn_'+inttostr(NumConnection));

s:='';

if not (i=-1)

then s:=(ListComposants.Objects[i] as TButton).Caption;

if s='Cancel'

then ServerTrsFl1.AnnulerFichier(NumConnection)

else

if s='Close'

then

begin

end

else

if s='Terminate'

then

begin

end;

(ListComposants.Objects[i] as TButton).Visible:=false;

(ListComposants.Objects[i] as TButton).OnClick:=nil;

(ListComposants.Objects[i] as TButton).Parent:=Form1;

i:=ListComposants.IndexOf('Label_'+inttostr(NumConnection));

if not (i=-1)

then

begin

ListComposants.Objects[i].Free;

ListComposants.Delete(i);

end;

i:=ListComposants.IndexOf('Gauge_'+inttostr(NumConnection));

if not(i=-1)

then

begin

ListComposants.Objects[i].Free;

ListComposants.Delete(i);

еnd;

i:=ListComposants.IndexOf('GrpBox_'+inttostr(NumConnection));

if not(i=-1)

then

begin

ListComposants.Objects[i].Free;

ListComposants.Delete(i);

end;

end;

procedure TForm1.ButtonOpenClick(Sender: TObject);

begin

ServerTrsFl1.PortTCP:=StrToInt(EditPortTCP.text);

ServerTrsFl1.PortUDP:=StrToInt(EditPortUDP.text);

ServerTrsFl1.Dossier:=editDossier.Text;

ServerTrsFl1.Active:=not ServerTrsFl1.Active;

end;

procedure TForm1.ButtonChgDsClick(Sender: TObject);

begin

SaveDialog1.FileName:=EditDossier.Text+'ici';

if SaveDialog1.Execute

then EditDossier.Text:=ExtractFilePath(SaveDialog1.FileName);

end;

procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,

NewHeight: Integer; var Resize: Boolean);

Begin

Resize:=true;

if NewWidth<293

then Resize:=false;

if NewHeight<143

then Resize:=false;

end;

end.

 

 



2016-01-05 440 Обсуждений (0)
Листинг серверной части приложения 0.00 из 5.00 0 оценок









Обсуждение в статье: Листинг серверной части приложения

Обсуждений еще не было, будьте первым... ↓↓↓

Отправить сообщение

Популярное:
Личность ребенка как объект и субъект в образовательной технологии: В настоящее время в России идет становление новой системы образования, ориентированного на вхождение...
Генезис конфликтологии как науки в древней Греции: Для уяснения предыстории конфликтологии существенное значение имеет обращение к античной...



©2015-2024 megaobuchalka.ru Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав. (440)

Почему 1285321 студент выбрали МегаОбучалку...

Система поиска информации

Мобильная версия сайта

Удобная навигация

Нет шокирующей рекламы



(0.008 сек.)