【delphi开源代码栏目提醒】：网学会员为需要delphi开源代码的朋友们搜集整理了frm_Server.pas相关资料，希望对各位网友有所帮助!

    unit frm_Server;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ScktComp,JPEG, ExtCtrls, XPMan;
    
    Const
      CPort = 3000;
    
    type
      TForm1 = class(TForm)
        SServer: TServerSocket;
        BtnClose: TButton;
        Image1: TImage;
        XPManifest1: TXPManifest;
        procedure SServerClientError(Sender: TObject;
          Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
          var ErrorCode: Integer);
        procedure FormCreate(Sender: TObject);
        procedure BtnCloseClick(Sender: TObject);
        procedure SServerClientConnect(Sender: TObject;
          Socket: TCustomWinSocket);
        procedure SServerClientDisconnect(Sender: TObject;
          Socket: TCustomWinSocket);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
        procedure SServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
      private
        MemStream:TMemoryStream;
        procedure Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
        procedure CapBitmap(AMemstream:TMemoryStream);
        { Private declarations }
      public
    
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    implementation
    
    {$R *.dfm}
    
    procedure TForm1.SServerClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    begin
      ErrorCode:=0;
    end;
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      if Sserver.Active then
        SServer.Active:=false;
      SServer.Port:=CPort;
      SServer.Active:=true;
      showmessage('OK！已经启动了！');
    end;
    
    procedure TForm1.BtnCloseClick(Sender: TObject);
    begin
      Close;
    end;
    
    procedure TForm1.SServerClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    begin
      //Memo1.Lines.Add('客户'+Socket.RemoteHost+'连接了！');
    end;
    
    procedure TForm1.SServerClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    begin
      //Memo1.Lines.Add('客户'+Socket.RemoteHost+'断开了！！');
    end;
    
    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
      Sserver.Active:=false;
    end;
    
    procedure TForm1.CapBitmap(AMemstream:TMemoryStream);
    var
      bitmap:Tbitmap;
      JPEGS:TJPEGImage;
    begin
      JPEGS:=TJPEGImage.Create;
      Cjt_GetScreen(bitmap,true);
      Jpegs.Assign(Bitmap);
      Jpegs.CompressionQuality:=50;
      Jpegs.Compress;
      JPEGS.SaveToStream(AMemstream);
      AMemstream.Position:=0;
      bitmap.Free;
      Jpegs.Free;
    end;
    
    
    procedure TForm1.Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
    var
      Cursorx, Cursory: integer;
      dc: hdc;
      Mycan: Tcanvas;
      R: TRect;
      DrawPos: TPoint;
      MyCursor: TIcon;
      hld: hwnd;
      Threadld: dword;
      mp: tpoint;
      pIconInfo: TIconInfo;
    begin
      Mybmp := Tbitmap.Create;
      Mycan := TCanvas.Create;
      dc := GetWindowDC(0);
      try
        Mycan.Handle := dc;
        R := Rect(0, 0, screen.Width, screen.Height);
        Mybmp.Width := R.Right;
        Mybmp.Height := R.Bottom;
        Mybmp.Canvas.CopyRect(R, Mycan, R);
      finally
        releaseDC(0, DC);
      end;
      Mycan.Handle := 0;
      Mycan.Free;
      if DrawCur then
      begin
        GetCursorPos(DrawPos);
        MyCursor := TIcon.Create;
        getcursorpos(mp);
        hld := WindowFromPoint(mp);
        Threadld := GetWindowThreadProcessId(hld, nil);
        AttachThreadInput(GetCurrentThreadId, Threadld, True);
        MyCursor.Handle := Getcursor();
        AttachThreadInput(GetCurrentThreadId, threadld, False);
        GetIconInfo(Mycursor.Handle, pIconInfo);
        cursorx := DrawPos.x - round(pIconInfo.xHotspot);
        cursory := DrawPos.y - round(pIconInfo.yHotspot);
        Mybmp.Canvas.Draw(cursorx, cursory, MyCursor);
        Mycursor.ReleaseHandle;
        MyCursor.Free;
      end;
    end;
    
    procedure TForm1.SServerClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    var
      Cmd:string;
    begin
      cmd:=Trim(Socket.ReceiveText);
      if Cmd = 'CapBitmap' then
      begin
        MemStream:=TMemoryStream.Create;
        CapBitmap(MemStream);
        Socket.SendText(inttostr(MemStream.size));
      end;
    
      if Cmd = 'SendReady' then
      begin
        MemStream.Position:=0;
        Socket.SendStream(MemStream);
        MemStream.Clear;
      end;
    
      if Cmd = 'TranceOver' then
      begin
        
      end;
    end;
    
    end.