Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so dont bother with any of their useless mail servers here and just use oauth login instead. Thank the nice Russians for causing that. :)
Paste
Pasted as Delphi by registered user mesutde ( 8 years ago )
unit Form_RemoteScreen;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.pngimage,
Vcl.ExtCtrls,
Vcl.StdCtrls;
type
Tfrm_RemoteScreen = class(TForm)
Screen_Image: TImage;
ScrollBox1: TScrollBox;
Menu_Panel: TPanel;
MouseIcon_Image: TImage;
KeyboardIcon_Image: TImage;
ResizeIcon_Image: TImage;
MouseRemote_CheckBox: TCheckBox;
KeyboardRemote_CheckBox: TCheckBox;
Resize_CheckBox: TCheckBox;
MouseIcon_checked_Image: TImage;
KeyboardIcon_checked_Image: TImage;
ResizeIcon_checked_Image: TImage;
ResizeIcon_unchecked_Image: TImage;
KeyboardIcon_unchecked_Image: TImage;
MouseIcon_unchecked_Image: TImage;
CaptureKeys_Timer: TTimer;
Chat_Image: TImage;
FileShared_Image: TImage;
ScreenStart_Image: TImage;
procedure Resize_CheckBoxClick(Sender: TObject);
procedure Resize_CheckBoxKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure KeyboardRemote_CheckBoxKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure MouseRemote_CheckBoxKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure KeyboardRemote_CheckBoxClick(Sender: TObject);
procedure MouseRemote_CheckBoxClick(Sender: TObject);
procedure Screen_ImageMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure Screen_ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Screen_ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
/// <summary>
/// dgfgf
/// </summary>
procedure SendSocketKeys(Keys: string);
procedure CaptureKeys_TimerTimer(Sender: TObject);
procedure Chat_ImageClick(Sender: TObject);
procedure FileShared_ImageClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Screen_ImageDblClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
private
procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
message WM_GETMINMAXINFO;
{ Private declarations }
public
CtrlPressed, ShiftPressed, AltPressed: Boolean;
{ Public declarations }
function KeyboardLangCode: string;
end;
var
frm_RemoteScreen: Tfrm_RemoteScreen;
implementation
{$R *.dfm}
uses
Form_Main, Form_Chat, Form_ShareFiles;
function Tfrm_RemoteScreen.KeyboardLangCode: string;
var
LocalVal: array [0 .. 63] of Char;
LayOuts: array [0 .. 20] of HKL;
LangCount: integer;
i: integer;
LocalId: integer;
arrNames: array [0 .. 20, 0 .. 4] of string;
m: integer;
LType: integer;
begin
fillchar(LayOuts, SizeOf(LayOuts), #0);
fillchar(arrNames, SizeOf(arrNames), #0);
LangCount := GetKeyboardLayoutList(SizeOf(LayOuts), LayOuts[0]);
for i := 0 to LangCount - 1 do
begin
LType := 0;
LocalId := MAKELCID(LayOuts[i], SORT_DEFAULT);
GetLocaleInfo(LocalId, LOCALE_ILANGUAGE, @LocalVal, 64);
arrNames[i, 0] := LocalVal;
GetLocaleInfo(LocalId, LOCALE_SLANGUAGE, @LocalVal, 64);
arrNames[i, 1] := LocalVal;
GetLocaleInfo(LocalId, LOCALE_SENGLANGUAGE, @LocalVal, 64);
arrNames[i, 2] := LocalVal;
GetLocaleInfo(LocalId, LOCALE_SABBREVLANGNAME, @LocalVal, 64);
arrNames[i, 3] := LocalVal;
GetLocaleInfo(LocalId, LOCALE_SNATIVELANGNAME, @LocalVal, 64);
arrNames[i, 4] := LocalVal;
end;
Result := arrNames[0, 0]; // 041f = turkish q keyboard code
end;
procedure Tfrm_RemoteScreen.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
{ sets Size-limits for the Form }
var
MinMaxInfo: PMinMaxInfo;
begin
inherited;
MinMaxInfo := Message.MinMaxInfo;
MinMaxInfo^.ptMinTrackSize.X := 800; // Minimum Width
MinMaxInfo^.ptMinTrackSize.Y := 500; // Minimum Height
if (Resize_CheckBox.Checked) then
begin
MinMaxInfo^.ptMaxTrackSize.X := frm_Main.ResolutionTargetWidth;
MinMaxInfo^.ptMaxTrackSize.Y := frm_Main.ResolutionTargetHeight;
end
else
begin
MinMaxInfo^.ptMaxTrackSize.X := frm_Main.ResolutionTargetWidth + 20;
MinMaxInfo^.ptMaxTrackSize.Y := frm_Main.ResolutionTargetHeight + 120;
end;
end;
procedure Tfrm_RemoteScreen.SendSocketKeys(Keys: string);
begin
if (Active) then
frm_Main.Keyboard_Socket.Socket.SendText(Keys);
end;
procedure Tfrm_RemoteScreen.CaptureKeys_TimerTimer(Sender: TObject);
var
i: Byte;
trkey: string;
begin
// The keys programmed here, may not match the keys on your keyboard. I recommend to undertake adaptation.
try
{ Combo }
if (Active) then
begin
// Alt
if not(AltPressed) then
begin
if (GetKeyState(VK_MENU) < 0 xss=removed>');
end;
end
else
begin
if (GetKeyState(VK_MENU) > -1) then
begin
AltPressed := false;
SendSocketKeys('<|ALTUP|>');
end;
end;
// Ctrl
if not(CtrlPressed) then
begin
if (GetKeyState(VK_CONTROL) < 0 xss=removed>');
end;
end
else
begin
if (GetKeyState(VK_CONTROL) > -1) then
begin
CtrlPressed := false;
SendSocketKeys('<|CTRLUP|>');
end;
end;
// Shift
if not(ShiftPressed) then
begin
if (GetKeyState(VK_SHIFT) < 0 xss=removed>');
end;
end
else
begin
if (GetKeyState(VK_SHIFT) > -1) then
begin
ShiftPressed := false;
SendSocketKeys('<|SHIFTUP|>');
end;
end;
end;
for i := 8 to 228 do
begin
if (GetAsyncKeyState(i) = -32767) then
begin
// KeyboardLangCode
case i of
8:
SendSocketKeys('{BS}');
9:
SendSocketKeys('{TAB}');
13:
SendSocketKeys('{ENTER}');
27:
SendSocketKeys('{ESCAPE}');
32:
SendSocketKeys(' ');
33:
SendSocketKeys('{PGUP}');
34:
SendSocketKeys('{PGDN}');
35:
SendSocketKeys('{END}');
36:
SendSocketKeys('{HOME}');
37:
SendSocketKeys('{LEFT}');
38:
SendSocketKeys('{UP}');
39:
SendSocketKeys('{RIGHT}');
40:
SendSocketKeys('{DOWN}');
44:
SendSocketKeys('{PRTSC}');
46:
SendSocketKeys('{DEL}');
145:
SendSocketKeys('{SCROLLLOCK}');
// Numbers: 1 2 3 4 5 6 7 8 9 and ! @ # $ % ¨& * ( )
48:
if not(KeyboardLangCode = '041f') then
begin
if (GetKeyState(VK_SHIFT) < 0 not(KeyboardLangCode = '041f' not(KeyboardLangCode = '041f' not(KeyboardLangCode = '041f' not(KeyboardLangCode = '041f' not(KeyboardLangCode = '041f' not(KeyboardLangCode = '041f' not(KeyboardLangCode = '041f' xss=removed KeyboardLangCode = '041f' xss=removed not(KeyboardLangCode = '041f' not(KeyboardLangCode = '041f'>')
else
SendSocketKeys('.');
end
else
begin
if (GetKeyState(VK_SHIFT) < 0 not(KeyboardLangCode = '041f' not(KeyboardLangCode = '041f' not(KeyboardLangCode = '041f' not(KeyboardLangCode = '041f' not(KeyboardLangCode = '041f' KeyboardLangCode = '041f' KeyboardLangCode = '041f' xss=removed KeyboardLangCode = '041f' xss=removed xss=removed xss=removed xss=removed xss=removed xss=removed KeyboardLangCode = '041f' xss=removed not(trkey = '' xss=removed>');
frm_Main.SetOnline;
frm_Main.Show;
end;
procedure Tfrm_RemoteScreen.FormCreate(Sender: TObject);
begin
// Separate Window
SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_APPWINDOW);
end;
procedure Tfrm_RemoteScreen.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
if (MouseRemote_CheckBox.Checked) then
frm_Main.Main_Socket.Socket.SendText('<|REDIRECT|><|WHEELMOUSE|>' +
IntToStr(WheelDelta) + '<|END|>');
end;
procedure Tfrm_RemoteScreen.FormShow(Sender: TObject);
begin
CtrlPressed := false;
ShiftPressed := false;
AltPressed := false;
end;
procedure Tfrm_RemoteScreen.KeyboardRemote_CheckBoxClick(Sender: TObject);
begin
if (KeyboardRemote_CheckBox.Checked) then
begin
KeyboardIcon_Image.Picture.Assign(KeyboardIcon_checked_Image.Picture);
CaptureKeys_Timer.Enabled := true;
end
else
begin
KeyboardIcon_Image.Picture.Assign(KeyboardIcon_unchecked_Image.Picture);
CaptureKeys_Timer.Enabled := false;
end;
end;
procedure Tfrm_RemoteScreen.KeyboardRemote_CheckBoxKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
if Key = VK_SPACE then
Key := 0;
end;
procedure Tfrm_RemoteScreen.MouseRemote_CheckBoxClick(Sender: TObject);
begin
if (MouseRemote_CheckBox.Checked) then
begin
MouseIcon_Image.Picture.Assign(MouseIcon_checked_Image.Picture);
end
else
begin
MouseIcon_Image.Picture.Assign(MouseIcon_unchecked_Image.Picture);
end;
end;
procedure Tfrm_RemoteScreen.MouseRemote_CheckBoxKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
if (Key = VK_SPACE) then
Key := 0;
end;
procedure Tfrm_RemoteScreen.Resize_CheckBoxClick(Sender: TObject);
begin
if (Resize_CheckBox.Checked) then
begin
Screen_Image.AutoSize := false;
Screen_Image.Stretch := true;
Screen_Image.Align := alClient;
ResizeIcon_Image.Picture.Assign(ResizeIcon_checked_Image.Picture);
end
else
begin
Screen_Image.AutoSize := true;
Screen_Image.Stretch := false;
Screen_Image.Align := alNone;
ResizeIcon_Image.Picture.Assign(ResizeIcon_unchecked_Image.Picture);
end;
end;
procedure Tfrm_RemoteScreen.Resize_CheckBoxKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
if Key = VK_SPACE then
Key := 0;
end;
procedure Tfrm_RemoteScreen.Screen_ImageDblClick(Sender: TObject);
begin
if (Active) and (MouseRemote_CheckBox.Checked) then
begin
frm_Main.Main_Socket.Socket.SendText('<|REDIRECT|><|SETMOUSEDOUBLECLICK|>');
end;
end;
procedure Tfrm_RemoteScreen.Screen_ImageMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Active) and (MouseRemote_CheckBox.Checked) then
begin
X := (X * frm_Main.ResolutionTargetWidth) div (Screen_Image.Width);
Y := (Y * frm_Main.ResolutionTargetHeight) div (Screen_Image.Height);
if (Button = mbLeft) then
frm_Main.Main_Socket.Socket.SendText
('<|REDIRECT|><|SETMOUSELEFTCLICKDOWN|>' + IntToStr(X) + '<|>' +
IntToStr(Y) + '<|END|>')
else if (Button = mbRight) then
frm_Main.Main_Socket.Socket.SendText
('<|REDIRECT|><|SETMOUSERIGHTCLICKDOWN|>' + IntToStr(X) + '<|>' +
IntToStr(Y) + '<|END|>')
else
frm_Main.Main_Socket.Socket.SendText('<|REDIRECT|><|SETMOUSEMIDDLEDOWN|>'
+ IntToStr(X) + '<|>' + IntToStr(Y) + '<|END|>')
end;
end;
procedure Tfrm_RemoteScreen.Screen_ImageMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if (Active) and (MouseRemote_CheckBox.Checked) then
begin
X := (X * frm_Main.ResolutionTargetWidth) div (Screen_Image.Width);
Y := (Y * frm_Main.ResolutionTargetHeight) div (Screen_Image.Height);
frm_Main.Main_Socket.Socket.SendText('<|REDIRECT|><|SETMOUSEPOS|>' +
IntToStr(X) + '<|>' + IntToStr(Y) + '<|END|>');
end;
end;
procedure Tfrm_RemoteScreen.Screen_ImageMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (Active) and (MouseRemote_CheckBox.Checked) then
begin
X := (X * frm_Main.ResolutionTargetWidth) div (Screen_Image.Width);
Y := (Y * frm_Main.ResolutionTargetHeight) div (Screen_Image.Height);
if (Button = mbLeft) then
frm_Main.Main_Socket.Socket.SendText('<|REDIRECT|><|SETMOUSELEFTCLICKUP|>'
+ IntToStr(X) + '<|>' + IntToStr(Y) + '<|END|>')
else if (Button = mbRight) then
frm_Main.Main_Socket.Socket.SendText
('<|REDIRECT|><|SETMOUSERIGHTCLICKUP|>' + IntToStr(X) + '<|>' +
IntToStr(Y) + '<|END|>')
else
frm_Main.Main_Socket.Socket.SendText('<|REDIRECT|><|SETMOUSEMIDDLEUP|>' +
IntToStr(X) + '<|>' + IntToStr(Y) + '<|END|>')
end;
end;
end.
Revise this Paste