boatmain.~pas

关于网络编程的一个delphi程序。其实现的功能是通过无线网络实现监控。

unit BoatMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzCommon, Menus, ExtCtrls, RzPanel, RzButton, RzGroupBar,
  ScktComp, RzStatus,jpeg, StdCtrls, Mask, RzEdit, RzSplit,Image,GPS,Sensor;

type
  TMainForm = class(TForm)
    MainMenu: TMainMenu;
    RzMenuController: TRzMenuController;
    N1: TMenuItem;
    RzToolbar: TRzToolbar;
    btnImage: TRzToolButton;
    rzspcr1: TRzSpacer;
    btnGPS: TRzToolButton;
    rzspcr2: TRzSpacer;
    RzGroupBoxServer: TRzGroupBox;
    RzGroupBoxImage: TRzGroupBox;
    RzGroupBar1: TRzGroupBar;
    RzGroupImage: TRzGroup;
    rzgrpGPS: TRzGroup;
    Image: TImage;
    serverImageControl: TServerSocket;
    serverImage: TServerSocket;
    serverGPS: TServerSocket;
    RzStatusBar1: TRzStatusBar;
    RzStatusPane1: TRzStatusPane;
    RzStatusPaneImage: TRzStatusPane;
    RzStatusPaneGPS: TRzStatusPane;
    N2: TMenuItem;
    N3: TMenuItem;
    procedure RzGroupImageItems0Click(Sender: TObject);
    procedure RzGroupImageItems1Click(Sender: TObject);
    procedure serverImageControlAccept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure serverImageControlClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure serverImageControlClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure serverImageClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure rzgrpGPSItems0Click(Sender: TObject);
    procedure rzgrpGPSItems1Click(Sender: TObject);
    procedure serverGPSAccept(Sender: TObject; Socket: TCustomWinSocket);
    procedure serverGPSClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure serverGPSClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure btnImageClick(Sender: TObject);
    procedure btnGPSClick(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure rzgrpGPSItems5Click(Sender: TObject);
    procedure rzgrpGPSItems6Click(Sender: TObject);
    procedure rzgrpGPSItems7Click(Sender: TObject);
//    procedure rzgrpGPSItems1Click1(Sender: TObject);
//    procedure rzgrpGPSItems9Click(Sender: TObject);
//    procedure rzgrpGPSItems10Click(Sender: TObject);
    procedure rzgrpGPSItems8Click(Sender: TObject);
    procedure rzgrpGPSItems2Click(Sender: TObject);
    procedure rzgrpGPSItems3Click(Sender: TObject);
    procedure rzgrpGPSItems4Click(Sender: TObject);
  private
    { Private declarations }
    mImage : TMemoryStream;
    ImageSizeStr:string; //客户端发过来的图片大小字符串
    s:Integer;
    ImageTransFlg : Boolean;//图像传送标志位，true为传送，false为不传送
    i : Integer;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

(**********************************************************************)
{服务器控制模块}

{显示实时图像信息窗口}
procedure TMainForm.btnImageClick(Sender: TObject);
begin
  FormImage.Visible := True;
end;

{显示实时GPS信息窗口}
procedure TMainForm.btnGPSClick(Sender: TObject);
begin
  FormGPS.Visible := True;
end;
{***********************************************************}
{以下为图像传送模块}

{启动图像服务器}
procedure TMainForm.RzGroupImageItems0Click(Sender: TObject);
begin
  if serverImageControl.Active = True then
    serverImageControl.Active := False;
  try
    serverImageControl.Active := True;
  except
    ShowMessage('图像传输控制服务启动失败！');
  end;

  if serverImage.Active = True then
    serverImage.Active := False;
  try
    serverImage.Active := True;
    RzStatusPaneImage.Caption := ' 图像Server启动！';
    FormImage.edtImageServerState.text := 'Server已经启动！';
    FormImage.mmoImageServer.Lines.Add('图像Server已经启动！');
  except
    ShowMessage('图像Server启动失败！');
    FormImage.edtImageServerState.text := 'Server启动失败！';
    FormImage.mmoImageServer.Lines.Add('图像Server启动失败！');
  end;
  
  mImage := TMemoryStream.Create;
  ImageTransFlg := False;
end;

{停止图像服务器}
procedure TMainForm.RzGroupImageItems1Click(Sender: TObject);
begin
  if serverImageControl.Active then
    serverImageControl.Active := False;
  if serverImage.Active then
    serverImage.Active := True;
  RzStatusPaneImage.Caption := ' 图像Server停止！';
  FormImage.edtImageServerState.text := 'Server已经停止！';
  FormImage.mmoImageServer.Lines.Add('图像Server已经停止！');

  mImage.free;
end;

{图像客户端连接}
procedure TMainForm.serverImageControlAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  RzStatusPaneImage.Caption := ' 图像客户端'
                              + Socket.RemoteAddress
                              + '连接';
  FormImage.mmoImageServer.Lines.Add(' 图像客户端'
                                      + Socket.RemoteAddress
                                      + '已经连接');
end;

{图像客户端断开}
procedure TMainForm.serverImageControlClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  RzStatusPaneImage.Caption := ' 图像客户端'
                              + Socket.RemoteAddress
                              + '断开';
  FormImage.mmoImageServer.Lines.Add(' 图像客户端'
                                      + Socket.RemoteAddress
                                      + '已经断开');
end;

{传送图像大小}
procedure TMainForm.serverImageControlClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  mImage.Clear; //清空图片内存流
  
  ImageSizeStr:=socket.ReceiveText;
  s:=strtoint(ImageSizeStr); //设置需接收的字节数
  FormImage.mmoImageTrans.Lines.Add('收到图片大小为'+ImageSizeStr+'字节');
  Socket.sendtext('ok'); //通知服务端开始发送图象
  FormImage.mmoImageTrans.Lines.Add('开始接收图片！');
end;

{传送图像}
procedure TMainForm.serverImageClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  buffer:array [0..8191] of byte; //设置接收缓冲区
  len:integer;
  j:tjpegimage;
begin
  len:=socket.ReceiveLength;
  socket.ReceiveBuf(buffer,len); //接收数据包并读入缓冲区内
  mImage.Write(buffer,len); //追加入流M中
  if mImage.Size >= s then
  begin
    mImage.Position:=0;
    j:=tjpegimage.Create;
    try
      //mImage.Seek(0,soFromBeginning);
      mImage.Seek(0,s);
      j.LoadFromStream(mImage); //将流M中的数据读至JPG图像对象J中
      Image.Picture.Bitmap.Assign(j);

      Socket.SendText('ok');
    finally //以下为清除工作
      j.free;
      mImage.Clear;
      FormImage.mmoImageTrans.Lines.Add('图像传送完毕！');
    end;
end;
end;

{***************************************************************}
{以下为GPS模块}

{启动GPS服务器}
procedure TMainForm.rzgrpGPSItems0Click(Sender: TObject);
begin
  if serverGPS.Active then
    serverGPS.Active := False;
  try
    serverGPS.Active := True;
    RzStatusPaneGPS.Caption := '控制 Server已经启动！';
    FormGPS.edtGPSState.Text := 'Server已经启动！';
    FormGPS.mmoGPSServer.Lines.Add('控制 Server已经启动！');
  except
    ShowMessage('控制服务启动失败！');
    FormGPS.edtGPSState.Text := 'Server启动失败！';
    FormGPS.mmoGPSServer.Lines.Add('控制 Server启动失败！');
  end;
  i := 0;
end;

{停止GPS服务器}
procedure TMainForm.rzgrpGPSItems1Click(Sender: TObject);
begin
  if serverGPS.Socket.ActiveConnections > 0 then
    begin
      serverGPS.Socket.Connections[0].SendText('DISL');
      FormGPS.mmoGPSTrans.Lines.Add('DISL！');
    end;
  serverGPS.Active := False;
  serverGPS.Close;
  RzStatusPaneGPS.Caption := '控制 Server已经停止！';
  FormGPS.edtGPSState.Text := 'Server已经停止！';
  FormGPS.mmoGPSServer.Lines.Add('控制 Server已经停止！');
end;


{GPS客户端连接}
procedure TMainForm.serverGPSAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  RzStatusPaneGPS.Caption := '控制 '
                              + Socket.RemoteAddress
                              + '连接';
  FormGPS.mmoGPSServer.Lines.Add('控制 '
                              + Socket.RemoteAddress
                              + '连接');
end;

{GPS客户端断开}
procedure TMainForm.serverGPSClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  RzStatusPaneGPS.Caption := '控制 '
                              + Socket.RemoteAddress
                              + '断开';
    FormGPS.mmoGPSServer.Lines.Add('控制 '
                              + Socket.RemoteAddress
                              + '断开');
end;

{传送GPS信息}
procedure TMainForm.serverGPSClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  GPSstr : string;
begin
  GPSstr := Socket.ReceiveText;
  FormGPS.mmoGPSTrans.Lines.Add('对方收到' + GPSstr);
 {
  if GPSstr = 'GO' then
    FormGPS.mmoGPSTrans.Lines.Add('对方收到GO命令！');

  if GPSstr = 'BACK' then
    FormGPS.mmoGPSTrans.Lines.Add('对方收到BACK命令！');

  if GPSstr = 'UP' then
    FormGPS.mmoGPSTrans.Lines.Add('对方收到UP命令！');

  if GPSstr = 'DOWN' then
    FormGPS.mmoGPSTrans.Lines.Add('对方收到DOWN命令！');

  if GPSstr = 'LEFT' then
    FormGPS.mmoGPSTrans.Lines.Add('对方收到LEFT命令！');

  if GPSstr = 'RIGHT' then
    FormGPS.mmoGPSTrans.Lines.Add('对方收到RIGHT命令！')
 }
end;



{离开主窗口}
procedure TMainForm.N2Click(Sender: TObject);
begin
  MainForm.Close;
end;


//Go
procedure TMainForm.rzgrpGPSItems2Click(Sender: TObject);
begin
  if serverGPS.Socket.ActiveConnections > 0 then
    begin
      serverGPS.Socket.Connections[0].SendText('GO');
      FormGPS.mmoGPSTrans.Lines.Add('GO！');
    end;
end;

//BACK
procedure TMainForm.rzgrpGPSItems3Click(Sender: TObject);
begin
  if serverGPS.Socket.ActiveConnections > 0 then
    begin
      serverGPS.Socket.Connections[0].SendText('BACK');
      FormGPS.mmoGPSTrans.Lines.Add('BACK！');
    end;
end;

procedure TMainForm.rzgrpGPSItems4Click(Sender: TObject);
begin
  if serverGPS.Socket.ActiveConnections > 0 then
    begin
      serverGPS.Socket.Connections[0].SendText('STOP');
      FormGPS.mmoGPSTrans.Lines.Add('STOP！');
    end;
end;

//LEFT
procedure TMainForm.rzgrpGPSItems5Click(Sender: TObject);
begin
  if serverGPS.Socket.ActiveConnections > 0 then
    begin
      serverGPS.Socket.Connections[0].SendText('LEFT');
      FormGPS.mmoGPSTrans.Lines.Add('LEFT！');
    end;
end;

//RIGHT
procedure TMainForm.rzgrpGPSItems6Click(Sender: TObject);
begin
  if serverGPS.Socket.ActiveConnections > 0 then
    begin
      serverGPS.Socket.Connections[0].SendText('RIGHT');
      FormGPS.mmoGPSTrans.Lines.Add('RIGHT！');
    end;
end;

//UP
procedure TMainForm.rzgrpGPSItems7Click(Sender: TObject);
begin
  if serverGPS.Socket.ActiveConnections > 0 then
    begin
      serverGPS.Socket.Connections[0].SendText('UP');
      FormGPS.mmoGPSTrans.Lines.Add('UP！');
    end;
end;

//DOWN
procedure TMainForm.rzgrpGPSItems8Click(Sender: TObject);
begin
  if serverGPS.Socket.ActiveConnections > 0 then
    begin
      serverGPS.Socket.Connections[0].SendText('DOWN');
      FormGPS.mmoGPSTrans.Lines.Add('DOWN！');
    end;
end;

end.