unit _uf_sendFile;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ScktComp, xocLabel, ComCtrls;
type
T_FZendFile = class(TForm)
TmKBS: TTimer;
cpStat: TLabel;
ckbs: TLabel;
AA_0571_Label2: TLabel;
AA_0576_Label3: TLabel;
AA_0578_Label4: TLabel;
eSent: TLabel;
csiz: TLabel;
pers: TLabel;
AA_0580_Label1: TLabel;
tmrest: TLabel;
AA_0579_Label5: TLabel;
Image1: TImage;
AA_0569_canz: TButton;
gress: TProgressBar;
Image3: TImage;
Shape1: TShape;
Shape2: TShape;
AA_0583_eCapToUzer: TExoSeeLabel;
zzLocalFileName: TLabel;
AA_0570_Label6: TLabel;
Image2: TImage;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure AA_0569_canzClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure TmKBSTimer(Sender: TObject);
procedure FormShow(Sender: TObject);
protected
procedure CreateParams(var Params: TCreateParams); override;
public
_set_cancel:Boolean;
_OnActivatedDONE:Boolean;
__sToNick : string;
__sToIP : string;
__sFullFile: string;
_DataSENT :Int64;
_DataLAST :Int64;
end;
//------------------------------------------------
T_i_zunderFile_THREAD = class(TThread)
private
FCCC :TClientSocket;
TheFX :TFileStream;
POZ,SndLen :Int64;
kanseled :boolean;
cc_KK :boolean;
SIZA,_OffSET :Int64;
_BytesSENT :Int64;
_statCode :byte;
is_permission_ok :boolean;
is_file_sent_ok :boolean;
protected
procedure Execute; override;
procedure _contact_ok;
procedure shawa_c_Process;
procedure shawa_uzAxepted;
procedure On_i_zunderFile_thread_terminated(Sender: TObject);
public
FZendForm :T_FZendFile;
_ip,_nik :string;
_file_full :string;
constructor Create;
destructor Destroy; override;
end;
implementation
uses unit1,_uc_funcs,_uc_refs_consts, _uc_crypto, _uc_refs_vars,
_uc_GuiLanG;
{$R *.DFM}
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure T_FZendFile.CreateParams(var Params: TCreateParams);
begin
Inherited CreateParams(Params);
Params.WndParent := GetDesktopWindow;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=caFree;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.FormCreate(Sender: TObject);
begin
GoSetLANG(Self); //----- go loadLang --- if ok (1st here)
Caption:='ExoSee - '+___ccc__0004__FileSend;
_FXOC_MAIN._images.GetIcon(14,icon);
_set_cancel:=false;
_DataLAST:=0;
_OnActivatedDONE:=false;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose:=tag=5;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.AA_0569_canzClick(Sender: TObject);
begin
if AA_0569_canz.Tag=0 then _set_cancel:=true else close;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.FormActivate(Sender: TObject);
var
THrZND : T_i_zunderFile_THREAD;
begin
Update;
if (_OnActivatedDONE) then exit;
_OnActivatedDONE:=true;
Application.ProcessMessages;
THrZND:=T_i_zunderFile_THREAD.Create;
THrZND.FZendForm:=Self;
THrZND._nik:=__sToNick;
THrZND._ip:=__sToIP;
THrZND._file_full:=__sFullFile;
THrZND.Resume;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.TmKBSTimer(Sender: TObject);
var
kk:Int64;
begin
kk:=(_DataSENT - _DataLAST) ;
if (kk<1) then exit;
//tmrest.Caption:= _time_left((csiz.Tag - tm_kbs.tag) div kk);
ckbs.Caption :=_octos(kk)+'/s'; // kbs
_DataLAST :=_DataSENT;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.FormShow(Sender: TObject);
begin
zzLocalFileName.Hint:=__sFullFile;
zzLocalFileName.Caption:=ExtractFileName(__sFullFile);
AA_0583_eCapToUzer.Caption:=AA_0583_eCapToUzer.Caption+__sToNick;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
constructor T_i_zunderFile_THREAD.Create;
begin
inherited Create(True); // Intially suspended
FreeOnTerminate := True;
OnTerminate := On_i_zunderFile_thread_terminated;
FCCC := TClientSocket.Create(Application);
FCCC.ClientType := ctBlocking;
end;
//------------------------------------------------------------------------------
destructor T_i_zunderFile_THREAD.Destroy;
begin
FCCC.Free;
inherited;
end;
//------------------------------------------------------------------------------
procedure T_i_zunderFile_THREAD._contact_ok;
begin
FZendForm.cpStat.Caption :=___ccc__0070__Waiting4permission;
Application.ProcessMessages;
end;
//------------------------------------------------------------------------------
procedure T_i_zunderFile_THREAD.shawa_c_Process;
begin
FZendForm._DataSENT :=_BytesSENT;
FZendForm.eSent.Caption :=_octos(_BytesSENT);
FZendForm.gress.Position :=TheFX.Position;
FZendForm.pers.Caption :=inttostr(_percenty(FZendForm.gress.Position,FZendForm.gress.Max))+'%';
FZendForm.Caption :=FZendForm.pers.Caption;
Application.ProcessMessages;
if FZendForm._set_cancel then kanseled:=true;
end;
//------------------------------------------------------------------------------
procedure T_i_zunderFile_THREAD.shawa_uzAxepted;
begin
FZendForm.csiz.Caption :=_octos(TheFX.Size);
FZendForm.csiz.Tag :=TheFX.Size;
FZendForm.eSent.Caption :=_octos(TheFX.Position);
FZendForm.ckbs.Caption :='0,0 Kb/s';
FZendForm.gress.Max :=TheFX.Size;
FZendForm.gress.Position :=TheFX.Position;
FZendForm.cpStat.Caption :=___ccc__0071__Uploading;
FZendForm.TmKBS.enabled:=true;
end;
//------------------------------------------------------------------------------
procedure T_i_zunderFile_THREAD.On_i_zunderFile_thread_terminated(Sender: TObject);
begin
FZendForm.tag :=5; // enable closing
FZendForm.AA_0569_canz.Tag :=1;
// add user upload level
FZendForm.TmKBS.enabled :=false;
FZendForm.AA_0569_canz.Caption :=___ccc__0072__Close;
if (not is_permission_ok) then begin
FZendForm.cpStat.Caption:=___ccc__0018__Aborted;
end;
if (is_permission_ok) and (is_file_sent_ok) then FZendForm.cpStat.Caption:=___ccc__0015__Completed;
if cc_KK then FZendForm.cpStat.Caption:=___ccc__0018__Aborted;
FZendForm.Caption :=FZendForm.cpStat.Caption;
FZendForm.tmrest.Caption :='00:00:00';
if kanseled then FZendForm.close;
end;
//------------------------------------------------------------------------------
procedure T_i_zunderFile_THREAD.Execute;
var
_Wsk: TWinSocketStream;
BufSize: Longint;
Buff: PByteArray;
s:string;
begin
kanseled :=false;
cc_KK :=false;
try //----------------t1
FCCC.Host__ip := _ip; // 11.11.11.11
FCCC.Port := _C_EXOSEE_MASTER_SERVER_PORT;
FCCC.Active := True;
_Wsk :=TWinSocketStream.Create(FCCC.Socket, 20000);
TheFX :=TFileStream.Create(_file_full,fmOpenRead or fmShareDenyWrite);
try ////----------------t2
FCCC.Socket.SendText(TCrypto._BarzaToon(_EXO_iZEND_FILE));
if _Wsk.WaitForData(10000) then // wait 10 sec
begin
s:=FCCC.Socket.ReceiveText;
if (s[2]='I') and (s[4]='i') then // info_signal given ... then go ....
begin
s:=_VV_LOCAL_USER_PC_ID+_VV_LOCAL_USER_NIKO+';[f:'+ExtractFileName(_file_full)+':f][z:'+inttostr(TheFX.Size)+':z]';
FCCC.Socket.SendText(TCrypto._BarzaToon(s)); //send : id + nik + file + size
Synchronize(_contact_ok);
_Wsk.WaitForData(60000);// then // wait 1 min its accepting there
begin
s:=TCrypto._SimSim(FCCC.Socket.ReceiveText); // must come like this 'PRM:OK:00000000'
if copy(s,1,7)='PRM:OK:' then
begin
is_permission_ok:=true;
_OffSET:=StrToInt64Def('$'+copy(s,8,16),0); // read remote offset
TheFX.Position := _OffSET; // resume
SIZA := (TheFX.Size-_OffSET);
Synchronize(shawa_uzAxepted); // user accepted
_Wsk.Write(SIZA, SizeOf(SIZA)); // it sends (size-offset) !!! ( how much it will start sending soon )
if SIZA < MAX_BUFFER_FILE_SEND then BufSize := SIZA else BufSize := MAX_BUFFER_FILE_SEND;
GetMem(Buff, BufSize);
Try
while (SIZA>0) and (FCCC.Socket.Connected) do
begin
if SIZA > BufSize then SndLen := BufSize else SndLen := SIZA;
TheFX.Read(Buff^, SndLen);
POZ := 0;
while (POZ < SndLen) do
begin
Inc(POZ, _Wsk.Write(Buff^[POZ], SndLen));
if (POZ=0) then begin cc_KK:=true; break; end;
end;
Dec(SIZA, SndLen);
_BytesSENT :=TheFX.Size-SIZA; // can be position too remove ka ka form !!!!!
Synchronize(shawa_c_Process);
if (kanseled or cc_KK or _THE_EXOSEE_APPLICATION_IS_TERMINATED) then break;
end;
if SIZA=0 then is_file_sent_ok:=true;
finally FreeMem(Buff); end; // !! never BufSize on freemem !!!
end; //end permission verif
end;
end
else _statCode:=0;
end
finally
TheFX.Free;
FCCC.Socket.Close;
//FCCC.Active :=false; //thread destrucot will free it
_Wsk.Free;
end; //----------------t2 FCCC.Socket.Close;
Except _statCode :=1; end;
//except Synchronize(shawaError); end; //----------------t1
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ScktComp, xocLabel, ComCtrls;
type
T_FZendFile = class(TForm)
TmKBS: TTimer;
cpStat: TLabel;
ckbs: TLabel;
AA_0571_Label2: TLabel;
AA_0576_Label3: TLabel;
AA_0578_Label4: TLabel;
eSent: TLabel;
csiz: TLabel;
pers: TLabel;
AA_0580_Label1: TLabel;
tmrest: TLabel;
AA_0579_Label5: TLabel;
Image1: TImage;
AA_0569_canz: TButton;
gress: TProgressBar;
Image3: TImage;
Shape1: TShape;
Shape2: TShape;
AA_0583_eCapToUzer: TExoSeeLabel;
zzLocalFileName: TLabel;
AA_0570_Label6: TLabel;
Image2: TImage;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure AA_0569_canzClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure TmKBSTimer(Sender: TObject);
procedure FormShow(Sender: TObject);
protected
procedure CreateParams(var Params: TCreateParams); override;
public
_set_cancel:Boolean;
_OnActivatedDONE:Boolean;
__sToNick : string;
__sToIP : string;
__sFullFile: string;
_DataSENT :Int64;
_DataLAST :Int64;
end;
//------------------------------------------------
T_i_zunderFile_THREAD = class(TThread)
private
FCCC :TClientSocket;
TheFX :TFileStream;
POZ,SndLen :Int64;
kanseled :boolean;
cc_KK :boolean;
SIZA,_OffSET :Int64;
_BytesSENT :Int64;
_statCode :byte;
is_permission_ok :boolean;
is_file_sent_ok :boolean;
protected
procedure Execute; override;
procedure _contact_ok;
procedure shawa_c_Process;
procedure shawa_uzAxepted;
procedure On_i_zunderFile_thread_terminated(Sender: TObject);
public
FZendForm :T_FZendFile;
_ip,_nik :string;
_file_full :string;
constructor Create;
destructor Destroy; override;
end;
implementation
uses unit1,_uc_funcs,_uc_refs_consts, _uc_crypto, _uc_refs_vars,
_uc_GuiLanG;
{$R *.DFM}
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure T_FZendFile.CreateParams(var Params: TCreateParams);
begin
Inherited CreateParams(Params);
Params.WndParent := GetDesktopWindow;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=caFree;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.FormCreate(Sender: TObject);
begin
GoSetLANG(Self); //----- go loadLang --- if ok (1st here)
Caption:='ExoSee - '+___ccc__0004__FileSend;
_FXOC_MAIN._images.GetIcon(14,icon);
_set_cancel:=false;
_DataLAST:=0;
_OnActivatedDONE:=false;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose:=tag=5;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.AA_0569_canzClick(Sender: TObject);
begin
if AA_0569_canz.Tag=0 then _set_cancel:=true else close;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.FormActivate(Sender: TObject);
var
THrZND : T_i_zunderFile_THREAD;
begin
Update;
if (_OnActivatedDONE) then exit;
_OnActivatedDONE:=true;
Application.ProcessMessages;
THrZND:=T_i_zunderFile_THREAD.Create;
THrZND.FZendForm:=Self;
THrZND._nik:=__sToNick;
THrZND._ip:=__sToIP;
THrZND._file_full:=__sFullFile;
THrZND.Resume;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.TmKBSTimer(Sender: TObject);
var
kk:Int64;
begin
kk:=(_DataSENT - _DataLAST) ;
if (kk<1) then exit;
//tmrest.Caption:= _time_left((csiz.Tag - tm_kbs.tag) div kk);
ckbs.Caption :=_octos(kk)+'/s'; // kbs
_DataLAST :=_DataSENT;
end;
//------------------------------------------------------------------------------
procedure T_FZendFile.FormShow(Sender: TObject);
begin
zzLocalFileName.Hint:=__sFullFile;
zzLocalFileName.Caption:=ExtractFileName(__sFullFile);
AA_0583_eCapToUzer.Caption:=AA_0583_eCapToUzer.Caption+__sToNick;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
constructor T_i_zunderFile_THREAD.Create;
begin
inherited Create(True); // Intially suspended
FreeOnTerminate := True;
OnTerminate := On_i_zunderFile_thread_terminated;
FCCC := TClientSocket.Create(Application);
FCCC.ClientType := ctBlocking;
end;
//------------------------------------------------------------------------------
destructor T_i_zunderFile_THREAD.Destroy;
begin
FCCC.Free;
inherited;
end;
//------------------------------------------------------------------------------
procedure T_i_zunderFile_THREAD._contact_ok;
begin
FZendForm.cpStat.Caption :=___ccc__0070__Waiting4permission;
Application.ProcessMessages;
end;
//------------------------------------------------------------------------------
procedure T_i_zunderFile_THREAD.shawa_c_Process;
begin
FZendForm._DataSENT :=_BytesSENT;
FZendForm.eSent.Caption :=_octos(_BytesSENT);
FZendForm.gress.Position :=TheFX.Position;
FZendForm.pers.Caption :=inttostr(_percenty(FZendForm.gress.Position,FZendForm.gress.Max))+'%';
FZendForm.Caption :=FZendForm.pers.Caption;
Application.ProcessMessages;
if FZendForm._set_cancel then kanseled:=true;
end;
//------------------------------------------------------------------------------
procedure T_i_zunderFile_THREAD.shawa_uzAxepted;
begin
FZendForm.csiz.Caption :=_octos(TheFX.Size);
FZendForm.csiz.Tag :=TheFX.Size;
FZendForm.eSent.Caption :=_octos(TheFX.Position);
FZendForm.ckbs.Caption :='0,0 Kb/s';
FZendForm.gress.Max :=TheFX.Size;
FZendForm.gress.Position :=TheFX.Position;
FZendForm.cpStat.Caption :=___ccc__0071__Uploading;
FZendForm.TmKBS.enabled:=true;
end;
//------------------------------------------------------------------------------
procedure T_i_zunderFile_THREAD.On_i_zunderFile_thread_terminated(Sender: TObject);
begin
FZendForm.tag :=5; // enable closing
FZendForm.AA_0569_canz.Tag :=1;
// add user upload level
FZendForm.TmKBS.enabled :=false;
FZendForm.AA_0569_canz.Caption :=___ccc__0072__Close;
if (not is_permission_ok) then begin
FZendForm.cpStat.Caption:=___ccc__0018__Aborted;
end;
if (is_permission_ok) and (is_file_sent_ok) then FZendForm.cpStat.Caption:=___ccc__0015__Completed;
if cc_KK then FZendForm.cpStat.Caption:=___ccc__0018__Aborted;
FZendForm.Caption :=FZendForm.cpStat.Caption;
FZendForm.tmrest.Caption :='00:00:00';
if kanseled then FZendForm.close;
end;
//------------------------------------------------------------------------------
procedure T_i_zunderFile_THREAD.Execute;
var
_Wsk: TWinSocketStream;
BufSize: Longint;
Buff: PByteArray;
s:string;
begin
kanseled :=false;
cc_KK :=false;
try //----------------t1
FCCC.Host__ip := _ip; // 11.11.11.11
FCCC.Port := _C_EXOSEE_MASTER_SERVER_PORT;
FCCC.Active := True;
_Wsk :=TWinSocketStream.Create(FCCC.Socket, 20000);
TheFX :=TFileStream.Create(_file_full,fmOpenRead or fmShareDenyWrite);
try ////----------------t2
FCCC.Socket.SendText(TCrypto._BarzaToon(_EXO_iZEND_FILE));
if _Wsk.WaitForData(10000) then // wait 10 sec
begin
s:=FCCC.Socket.ReceiveText;
if (s[2]='I') and (s[4]='i') then // info_signal given ... then go ....
begin
s:=_VV_LOCAL_USER_PC_ID+_VV_LOCAL_USER_NIKO+';[f:'+ExtractFileName(_file_full)+':f][z:'+inttostr(TheFX.Size)+':z]';
FCCC.Socket.SendText(TCrypto._BarzaToon(s)); //send : id + nik + file + size
Synchronize(_contact_ok);
_Wsk.WaitForData(60000);// then // wait 1 min its accepting there
begin
s:=TCrypto._SimSim(FCCC.Socket.ReceiveText); // must come like this 'PRM:OK:00000000'
if copy(s,1,7)='PRM:OK:' then
begin
is_permission_ok:=true;
_OffSET:=StrToInt64Def('$'+copy(s,8,16),0); // read remote offset
TheFX.Position := _OffSET; // resume
SIZA := (TheFX.Size-_OffSET);
Synchronize(shawa_uzAxepted); // user accepted
_Wsk.Write(SIZA, SizeOf(SIZA)); // it sends (size-offset) !!! ( how much it will start sending soon )
if SIZA < MAX_BUFFER_FILE_SEND then BufSize := SIZA else BufSize := MAX_BUFFER_FILE_SEND;
GetMem(Buff, BufSize);
Try
while (SIZA>0) and (FCCC.Socket.Connected) do
begin
if SIZA > BufSize then SndLen := BufSize else SndLen := SIZA;
TheFX.Read(Buff^, SndLen);
POZ := 0;
while (POZ < SndLen) do
begin
Inc(POZ, _Wsk.Write(Buff^[POZ], SndLen));
if (POZ=0) then begin cc_KK:=true; break; end;
end;
Dec(SIZA, SndLen);
_BytesSENT :=TheFX.Size-SIZA; // can be position too remove ka ka form !!!!!
Synchronize(shawa_c_Process);
if (kanseled or cc_KK or _THE_EXOSEE_APPLICATION_IS_TERMINATED) then break;
end;
if SIZA=0 then is_file_sent_ok:=true;
finally FreeMem(Buff); end; // !! never BufSize on freemem !!!
end; //end permission verif
end;
end
else _statCode:=0;
end
finally
TheFX.Free;
FCCC.Socket.Close;
//FCCC.Active :=false; //thread destrucot will free it
_Wsk.Free;
end; //----------------t2 FCCC.Socket.Close;
Except _statCode :=1; end;
//except Synchronize(shawaError); end; //----------------t1
end;
end.