ANTICHAT — форум по информационной безопасности, OSINT и технологиям

const
  x = 100;
  y = 50;
  w = 20;
  h = 30;
  x2 = 0;
  y2 = 0;
begin
  Image2.Canvas.CopyRect(Rect(x2, y2, w, h), Image1.Canvas,
    Rect(x, y, w+x, h+y));
end;

TESTFILE EXEFILE C:\Windows\Notepad.exe

{$R MYRES.RES}

var 
  Form1: TForm1; 
  NOTEPAD_FILE: string; 

implementation 

{$R *.DFM} 
{$R MYRES.RES} 

function GetTempDir: string; 
var 
  Buffer: array[0..MAX_PATH] of Char; 
begin 
  GetTempPath(SizeOf(Buffer) - 1, Buffer); 
  Result := StrPas(Buffer); 
end; 

// Extract the Resource 
function ExtractRes(ResType, ResName, ResNewName: string): Boolean; 
var 
  Res: TResourceStream; 
begin 
  Result := False; 
  Res := TResourceStream.Create(Hinstance, Resname, PChar(ResType)); 
  try 
    Res.SavetoFile(ResNewName); 
    Result := True; 
  finally 
    Res.Free; 
  end; 
end; 

// Execute the file 
procedure ShellExecute_AndWait(FileName: string); 
var 
  exInfo: TShellExecuteInfo; 
  Ph: DWORD; 
begin 
  FillChar(exInfo, SizeOf(exInfo), 0); 
  with exInfo do 
  begin 
    cbSize := SizeOf(exInfo); 
    fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT; 
    Wnd := GetActiveWindow(); 
    ExInfo.lpVerb := 'open'; 
    lpFile := PChar(FileName); 
    nShow := SW_SHOWNORMAL; 
  end; 
  if ShellExecuteEx(@exInfo) then 
  begin 
    Ph := exInfo.HProcess; 
  end 
  else 
  begin 
    ShowMessage(SysErrorMessage(GetLastError)); 
    Exit; 
  end; 
  while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do 
    Application.ProcessMessages; 
  CloseHandle(Ph); 
end; 

// To Test it 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if ExtractRes('EXEFILE', 'TESTFILE', NOTEPAD_FILE) then 
    if FileExists(NOTEPAD_FILE) then 
    begin 
      ShellExecute_AndWait(NOTEPAD_FILE); 
      ShowMessage('Notepad finished!'); 
      DeleteFile(NOTEPAD_FILE); 
    end; 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  NOTEPAD_FILE := GetTempDir + 'Notepad_FROM_RES.EXE'; 
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
  text: string;
begin
text := 'test';
AThread.Connection.ReadBuffer(Clientbuffer,SizeOf(Clientbuffer)); //читаем то что шлет клиент при подключении
Clientbuffer.login := AnsiLowerCase(Trim(Clientbuffer.Login)); //удаляем пробелы по краям и вводим в нижний регистр для сверки
if text = Clientbuffer.Login then //сверям
TidpeerThread(Athread).Connection.WriteLn('ok'); //если верно, отсылаем клиенту ОК
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
Msg    : String;
begin
Msg    := AThread.Connection.ReadLn; //читаем значение
memo1.Lines.Add(Msg); //записываем значение
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
with SendBuffer do
 begin
 Login := edit11.text; //заполняем буфер данными перед отправкой
 end;
idTCPclient1.Connect; //подключаемся
idTCPClient1.WriteBuffer(SendBuffer,SizeOf(SendBuffer),true); //шлем данные

if idTCPclient1.ReadLn = 'ok' then //если ответ ОК то
begin
Memo1.Lines.Add(Подрубились); //пишем подрубились
button2.enabled := true; //делаем кнопку доступной
end;

procedure TForm1.Button2Click(Sender: TObject);
var
A : integer = 0;
begin
inc(A);
IdTCPClient1.writeln(intToStr(A)); //отсылаем значение А серверу
end;