Código: Seleccionar todo

 
uses Windows, SysUtils, Classes, Graphics, Jpeg, WinInet;
 
function UploadScreen(Server: string; Port: Word; Username, Password: PChar): Boolean;
var
  hNet: HINTERNET;
  hCon: HINTERNET;
  hFile: HINTERNET;
  Context: DWORD;
  Bmp: Tbitmap;
  Jpg: TJPEGImage;
  Mem: TMemoryStream;
  Escritos: Cardinal;
begin
  Result := FALSE;
  Context:= 0;
  hNet := InternetOpen('agent', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if (hNet <> nil) then
  begin
    hCon:= InternetConnect(hNet,PChar(Server),Port,Username,Password,
      INTERNET_SERVICE_FTP,0,Context);
    if (hCon <> nil) then
    begin
      hFile:= FtpOpenFile(hCon,PChar(FormatDateTime('ddmmyyhhnnss',Now)+'.jpg'),GENERIC_WRITE,
        FTP_TRANSFER_TYPE_BINARY,Context);
      if (hFile <> nil) then
      begin
        Bmp:= Tbitmap.Create;
        Jpg:= TJPEGImage.Create;
        Mem:= TMemoryStream.Create;
        try
          try
            bmp.Width:= GetSystemMetrics(SM_CXSCREEN);
            bmp.Height:= GetSystemMetrics(SM_CYSCREEN);
            BitBlt(bmp.Canvas.Handle,0,0,bmp.Width,bmp.Height,GetDc(0),0,0,SRCCOPY);
            jpg.Assign(bmp);
            jpg.CompressionQuality:= 60;
            jpg.Compress;
            jpg.SaveToStream(Mem);
            if InternetWriteFile(hFile,Mem.Memory,Mem.Size,Escritos) then
              Result:= Mem.Size = Escritos
            else
              Result:= FALSE;
          except end;
        finally
          Mem.Free;
          Bmp.free;
          Jpg.free;
        end;
        InternetCloseHandle(hFile);
      end;
      InternetCloseHandle(hCon);
    end;
    InternetCloseHandle(hNet);
  end;
end;

Código: Seleccionar todo

var
  Usuario: string;
  Password: string;
begin
  Usuario:= 'fulanito';
  Password:= '';
  UploadScreen('127.0.0.1',21,PChar(Usuario),PChar(Password));
end;