Screen Capture of your Windows10 machine as a http://<ip>:8088/image.png

readme.md

Windows 10 Standalone Screen Sharing

This is a toy project that tests CHICKEN 5 on Windows, with its static linking of eggs support in particular, and something that might actually be useful:

This program provides the current screen capture on http://localhost:8088/alf.png. It also uses UPnP and IGD to expose itself into the wild, and prints the url where it shold be found from outside using the routers external IP.

The IGD router's root description url is hardcoded and everything is a mess. But it works for me.

Requirements

• CHICKEN 5
• Some CHICKEN eggs: srfi-13, srfi-18, stb-image-write
• miniupnpc
• Something to build it all together for Windows (I used http://msys2.org which was wonderful)

Build

I made it work like this in the msys2 mingw63 terminal:

csc -C "-DMINIUPNP_STATICLIB" -v -m main -static \
  -L -lgdi32 \
  -L /mingw64/lib/libminiupnpc.a \
  -L -liphlpapi \
  hjelp.scm

This gives me a 4MB hjelp.exe that uses shared libraries under C:\Windows only which should run on any vanilla Windows10 machine.

gdigrab.c

#include <windows.h>
#include <stdio.h>

int screen_w() {
  return GetSystemMetrics(SM_CXVIRTUALSCREEN)
    - GetSystemMetrics(SM_XVIRTUALSCREEN);
}

int screen_h() {
  return GetSystemMetrics(SM_CYVIRTUALSCREEN)
    - GetSystemMetrics(SM_YVIRTUALSCREEN);
}

void GetScreenShot(unsigned char* pixels, int w, int h)
{
  int x1, y1;
  x1  = GetSystemMetrics(SM_XVIRTUALSCREEN);
  y1  = GetSystemMetrics(SM_YVIRTUALSCREEN);

  // copy screen to bitmap
  HDC     hScreen = GetDC(GetDesktopWindow());
  HDC     hDC     = CreateCompatibleDC(hScreen);
  HBITMAP hBitmap = CreateCompatibleBitmap(hScreen, w, h);
  HGDIOBJ old_obj = SelectObject(hDC, hBitmap);
  BOOL    bRet    = BitBlt(hDC, 0, 0, w, h, hScreen, x1, y1, SRCCOPY | CAPTUREBLT);

  BITMAPINFOHEADER bmpInfoHeader = { sizeof(BITMAPINFOHEADER) };
  bmpInfoHeader.biWidth = w;
  bmpInfoHeader.biHeight = h;
  bmpInfoHeader.biPlanes = 1;
  bmpInfoHeader.biBitCount = 32;

  int bytespp = bmpInfoHeader.biBitCount / 8;
  int stride = ((w * bmpInfoHeader.biBitCount + 31) / 32) * bytespp;
  DWORD size = stride * h;
  BYTE *bits = malloc(size);

  if (GetDIBits(hDC, hBitmap, 0, h, bits,
                (BITMAPINFO*)&bmpInfoHeader, DIB_RGB_COLORS))
  {
    // abgr => rgba
    for(int y = 0 ; y < h ; y++) {
      for(int x = 0 ; x < w ; x++) {
        int i = (x * bytespp + ((h-y-1) * stride));
        int b = bits[i + 0];
        int g = bits[i + 1];
        int r = bits[i + 2];
        pixels [ (x + (y * w)) * 4 + 0] = r;
        pixels [ (x + (y * w)) * 4 + 1] = g;
        pixels [ (x + (y * w)) * 4 + 2] = b;
        pixels [ (x + (y * w)) * 4 + 3] = 0xFF;
      }
    }
  }
  else {
    fprintf(stderr, "get bits error\n");
  }

  free(bits);
  SelectObject(hDC, old_obj);
  DeleteDC(hDC);
  ReleaseDC(NULL, hScreen);
  DeleteObject(hBitmap);
}

hjelp.scm

(import (chicken tcp)
        (chicken foreign)
        (chicken string)
        (chicken port)
        (chicken io)
        (chicken pretty-print)
        (chicken condition)
        (chicken irregex)
        srfi-4
        srfi-13
        srfi-18
        stb-image-write)

(define (p . args)
  (display (apply conc args))
  (flush-output))

(define (fail . args)
  (apply p args)
  (p "\n")
  (read-line)
  (exit -1))

(cond-expand
 (windows
  (foreign-declare "#include \"gdigrab.c\"")
  (define screen-w (foreign-lambda int "screen_w"))
  (define screen-h (foreign-lambda int "screen_h"))
  (define ss! (foreign-lambda void "GetScreenShot" u8vector int int)))
 (else
  (define screen-w (lambda () 32))
  (define screen-h (lambda () 16))
  (define ss! (lambda (u8vector int int) #f))))

(define externalport 8088)
(define serverport 8088)

(foreign-declare "
#include <miniupnpc/miniupnpc.h>
#include <miniupnpc/upnpcommands.h>
")

;; quick and dirty NAT external port take-over
(define (nat-port-map iport eport #!optional
                      (rootdescurl "http://192.168.0.1:80/RootDevice.xml"))

  (let ((result
         ((foreign-lambda* int (((const c-string) rootdescurl)
                                ((const c-string) iport)
                                ((const c-string) eport))
                           "
  struct UPNPUrls urls;
  struct IGDdatas data;
  char lanaddr[64] = \"\";
  int r;

  if(!UPNP_GetIGDFromUrl(rootdescurl, &urls, &data, lanaddr, sizeof(lanaddr)))
    return -2;

  // overwrite existing entry
  UPNP_DeletePortMapping(urls.controlURL, data.first.servicetype,
                         eport, \"TCP\", 0);

  return(UPNP_AddPortMapping(urls.controlURL, data.first.servicetype,
                          iport, eport, lanaddr, \"ss alf\",
                          \"TCP\", 0, \"0\"));
")
          rootdescurl iport eport)))
    (unless (zero? result)
      (fail "obs! kunne ikke sette opp NAT: " result))))

;; fetch our external IP address from IGD router
(define (external-ip #!optional
                     (rootdescurl "http://192.168.0.1:80/RootDevice.xml"))

  (let* ((eip (make-string 64 #\null))
         (result
          ((foreign-lambda* int ((c-string rootdescurl)
                                 ((c-pointer char) dest_ip))
                            "
  struct UPNPUrls urls;
  struct IGDdatas data;

  if(!UPNP_GetIGDFromUrl(rootdescurl, &urls, &data, 0, 0))
    return -1;

  return(UPNP_GetExternalIPAddress(urls.controlURL,
                                  data.first.servicetype,
                                  dest_ip));")
           rootdescurl (location eip))))
    (if (zero? result)
        (string-filter (lambda (x) (not (eq? #\null x))) eip)
        (fail "OBS! fant ingen ekstern IP fra router."))))

(define eip (external-ip))

(define (screenshot)
  (define w (screen-w))
  (define h (screen-h))
  (define pix (make-u8vector (* w h 4)))
  (ss! pix w h)
  (values pix w h))

(receive (screenshot))

(nat-port-map (number->string serverport)
              (number->string externalport))

;; print cmd.exe's beutiful charset table:
;; (let loop ((n 255))
;;   (p  n " " (integer->char n) "\t")
;;   (when (> n 0) (loop (- n 1))))

(define å "\x86")
(define ø "\x94")

(p "

  Hei Alf!

  Dette programmet gj"ø"r skermbildet ditt tilgjengelig p"å" Internett
  for de gangene du trenger \"teknisk assistanse\".
  Hele skjermen din vises til de som g"å"r p"å" linken nedenfor,
  oppgi denne til en av oss! Avslutt ved "å" lukke dette vinduet.
  H"å"per det funker og lykke til!

  http://" eip ":" externalport "/alf.png

")

(define l (tcp-listen serverport))

(define (app ip op)

  (define requestline (read-line ip))
  (p "<< " (cadr (receive (tcp-addresses ip))) " "
     (with-output-to-string (lambda () (write requestline))) " ")

  ;; eat other headers
  (let loop ((line #f))
    (unless (or (eof-object? line)
                (equal? line ""))
      ;;(p " << " (with-output-to-string (lambda () (write line))) "\n")
      (loop (read-line ip))))

  (if (irregex-search " /alf.png " requestline)
      (begin
        (p "200\n")
        (receive (pix w h) (screenshot)
          (define body
            (with-output-to-string
              (lambda ()
                (write-png pix w h 4))))
          (display (conc "HTTP/1.1 200 OK\r
Server: chicken5 alfss klm\r
Content-type: image/png\r
Content-length: " (string-length body) "\r
Connection: close\r
\r
") op)
          (display body op)
          (flush-output op)))
      (begin
        (p "404\n")
        (display (conc "HTTP/1.1 404 Not Found\r
Server: chicken5 alfss klm\r
Connection: close\r
\r
") op)
        (flush-output op))))

(define
  thread-server
  (thread-start!
   (lambda ()
     (let loop ()
       (receive (ip op) (tcp-accept l)
         (thread-start!
          (lambda ()
            (handle-exceptions e (begin (pp e))
                               (app ip op))
            (close-input-port ip)
            (close-output-port op))))
       (loop)))))

(let loop ()
  (p "\r" " - ")  (thread-sleep! 0.25)
  (p "\r" " \\ ") (thread-sleep! 0.25)
  (p "\r" " | ")  (thread-sleep! 0.25)
  (p "\r" " / ")  (thread-sleep! 0.25)
  (loop))