unit_server_main.~pas

这是Delphi开发的GPS系统的原代码势力程序

procedure TForm_Server_Main.AddConnectionsInfo1;
var
  I, X     : Integer;
  AddToSCS : Boolean;
begin

  AddToSCS := True;
  for I := 0 to High(ServerConnectionStatus) do
  begin
    if (ServerConnectionStatus[I].tcsScreenName = 'Empty') then
      begin
        AddToSCS := False;
        Break;
      end;
  end;


  if (AddToSCS) then //An empty slot was not found so add one and use it
    begin
      SetLength(ServerConnectionStatus, Length(ServerConnectionStatus) + 1);
      X := High(ServerConnectionStatus);
    end
  else
    X := I;

  with ServerConnectionStatus[X] do
  begin
    tcsActiveConnections := X;
    tcsScreenName        := Tempno;
    tcsLocalHost         := LocalHost1;
    tcsLocalAddress      := LocalAddress1;
    tcsLocalPort         := LocalPort1;

    tcsRemoteAddress     := RemoteAddress1;
    tcsRemotePort        := RemotePort1;
    tcsServerPrivateMsg  := False;
    tcsSocketHandle      := SocketHandle1;
    tcsServerSocketHWND  := ServerSocketHWND1;
  end;
end;



procedure TForm_Server_Main.DeleteConnectionsInfo(ClientInfo : TServerConnectionStatus);
var
  J : Integer;
begin
  //Find the Entry and clear it
  for J := 0 to High(ServerConnectionStatus) do
    with ServerConnectionStatus[J] do
    begin
      if (tcsRemoteAddress = ClientInfo.tcsRemoteAddress) and
         (tcsRemotePort = ClientInfo.tcsRemotePort) then
         begin
           tcsActiveConnections := 0;
           tcsScreenName        := 'Empty';
           tcsLocalHost         := '';
           tcsLocalAddress      := '';
           tcsLocalPort         := 0;
           tcsRemoteAddress     := '';
           tcsRemotePort        := 0;
           tcsServerPrivateMsg  := False;
           tcsSocketHandle      := INVALID_SOCKET;
           tcsServerSocketHWND  := 0;
           Break;
         end;

    end;
end;

procedure TForm_Server_Main.DeleteConnectionsInfo(I : Integer);
begin
  with ServerConnectionStatus[I] do
  begin
     tcsActiveConnections := 0;
     tcsScreenName        := 'Empty';
     tcsLocalHost         := '';
     tcsLocalAddress      := '';
     tcsLocalPort         := 0;
//     tcsRemoteHost        := '';
     tcsRemoteAddress     := '';
     tcsRemotePort        := 0;
     tcsServerPrivateMsg  := False;
     tcsSocketHandle      := INVALID_SOCKET;
     tcsServerSocketHWND  := 0;
   end;
end;

function TForm_Server_Main.CreateLoginList : string;
var
  I : Integer;
begin
  //Result := '"Server Admin"';
  for I := 0 to High(ServerConnectionStatus) do
    if (ServerConnectionStatus[I].tcsScreenName <> 'Empty') then
      Result := Result + '<' + ServerConnectionStatus[I].tcsScreenName           + ':'
                             + ServerConnectionStatus[I].tcsLocalAddress         + ':'
                             + IntToStr(ServerConnectionStatus[I].tcsLocalPort ) + ':'
                             + ServerConnectionStatus[I].tcsRemoteAddress        + ':'
                             + IntToStr(ServerConnectionStatus[I].tcsRemotePort) + ':'
                             +  '>';
end;

procedure TForm_Server_Main.BroadcastLoginListUpdate(ExcludeSocket: TCustomWinSocket);
var
  I : Integer;
  //LoginList : string;
begin
  //LoginList := CreateLoginList;
  for I := 0 to (ChatServerSocket.Socket.ActiveConnections - 1) do
    with ChatServerSocket.Socket.Connections[I] do
    begin
      //if ((ExcludeSocket.RemoteAddress <> RemoteAddress) or
      //    (ExcludeSocket.RemotePort <> RemotePort)) then
      //    if Connected then SendText('*'); //Let the other users know that their list should be refreshed
//      if ChatServerSocket.Socket.Connections[I].RemoteHost  = 'JINTIAN'  then
//          if Connected then SendText(CreateLoginList ); //Let the other users know that their list should be refreshed
          //if Connected then SendText(LoginList); //this could be used to update their list automatically
    end;
end;

procedure TForm_Server_Main.sgServerConnectionsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  I, J : Integer;
  X : TListItem;
begin
  if ((Key = VK_DELETE) and (sgServerConnections.Row <> 0)) then
    begin
      I := sgServerConnections.Row - 1;
      for J := 0 to (ChatServerSocket.Socket.ActiveConnections - 1) do
        with ChatServerSocket.Socket.Connections[J] do
        begin
          if (ServerConnectionStatus[I].tcsRemoteAddress = RemoteAddress) and
             (ServerConnectionStatus[I].tcsRemotePort = RemotePort) then
             if Connected then
             begin
               X := lvServerActivity.Items.Add;
               X.Caption := 'Client Disconnecting...';
               X.SubItems.Add(RemoteHost);
               X.SubItems.Add(RemoteAddress);
               X.SubItems.Add(IntToStr(RemotePort));
               Close;
               X.Caption := 'Client Disconnected';
               X.SubItems.Add(FormatDateTime(StatusDateTimeFormat, Now));
               Break;
            end;
        end;
      DeleteConnectionsInfo(I);
      DisplayConnectionsInfo;
    end;
end;

procedure TForm_Server_Main.FormCreate(Sender: TObject);
var
  str:string;
begin
  //Setup Columns
  str:= ExtractFilePath(Application.ExeName)+'ip.ini';
  f:=tinifile.Create(str);
  clientip.Text :=f.ReadString('Transfer','00','') ;
  with sgServerConnections do
  begin
    Cells[1,0] := '#';
    ColWidths[1] := 25;
    Cells[2,0] := '通讯地址';
    ColWidths[2] := 100;
    Cells[3,0] := '本地机名';
    ColWidths[3] := 100;
    Cells[4,0] := '本地IP';
    ColWidths[4] := 100;
    Cells[5,0] := '本地端口';
    ColWidths[5] := 75;
    Cells[6,0] := '远程主机';
    ColWidths[6] := 100;
    Cells[7,0] := '远程IP';
    ColWidths[7] := 100;
    Cells[8,0] := '远程端口';
    ColWidths[8] := 75;
  end;

  ClickB := False ;
end;

procedure TForm_Server_Main.FormClose(Sender: TObject; var Action: TCloseAction);
var
  I : Integer;
begin

      with ChatServerSocket.Socket do
      begin
        for I := 0 to (ActiveConnections - 1) do
          if Connections[I].Connected then Connections[I].Close;
      end;

end;

procedure TForm_Server_Main.memReceiveKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_DELETE) then memReceive.Clear;
end;



procedure TForm_Server_Main.Button1Click(Sender: TObject);
var i , x : Integer ;
    y :array[0..17] of byte ;
begin
 memo1.Clear;
end;

procedure TForm_Server_Main.Button2Click(Sender: TObject);
var i , x : Integer ;
    y :array[0..50] of byte ;
begin
  DisplayConnectionsInfo;
  lvServerActivity.Items.Clear;
  //memo1.Clear;
end;

procedure TForm_Server_Main.Button3Click(Sender: TObject);
var i , x : Integer ;
    y :array[0..50] of byte ;
begin

end;

procedure TForm_Server_Main.E901E ;
var i , x : Integer ;
    y :array[0..17] of byte ;
begin
   y[0] := $fe ;
   y[1] := $fe ;
   y[2] := $fe ;
   y[3] := $fe ;
   y[4] := $68 ;
   y[5] := $99 ;
   y[6] := $99 ;
   y[7] := $99 ;
   y[8] := $99 ;
   y[9] := $99 ;
   y[10] := $99 ;
   y[11] := $68 ;
   y[12] := $1 ;
   y[13] := $2 ;
   y[14] := $1e + $33 ;
   y[15] := $90 + $33 ;

   x := 0 ;
   for i := 4 to 15 do
       x := x + y[i] ;

   y[16] := x mod 256 ;
   y[17] := $16 ;

   for i := 0 to ChatServerSocket.Socket.ActiveConnections - 1 do
     begin
      if ChatServerSocket.Socket.Connections[i].RemoteAddress <> clientip.Text then
        ChatServerSocket.Socket.Connections[i].SendBuf(y,18) ;
     end ;
end;
procedure TForm_Server_Main.E902E ;
var i , x : Integer ;
    y :array[0..17] of byte ;
begin
   y[0] := $fe ;
   y[1] := $fe ;
   y[2] := $fe ;
   y[3] := $fe ;
   y[4] := $68 ;
   y[5] := $99 ;
   y[6] := $99 ;
   y[7] := $99 ;
   y[8] := $99 ;
   y[9] := $99 ;
   y[10] := $99 ;
   y[11] := $68 ;
   y[12] := $1 ;
   y[13] := $2 ;
   y[14] := $2e + $33 ;
   y[15] := $90 + $33 ;

   x := 0 ;
   for i := 4 to 15 do
       x := x + y[i] ;

   y[16] := x mod 256 ;
   y[17] := $16 ;

   for i := 0 to ChatServerSocket.Socket.ActiveConnections - 1 do
     begin
      if ChatServerSocket.Socket.Connections[i].RemoteAddress <> clientip.Text then
        ChatServerSocket.Socket.Connections[i].SendBuf(y,18) ;
     end ;
end;
procedure TForm_Server_Main.EB62F ;
var i , x : Integer ;
    y :array[0..17] of byte ;
begin
   y[0] := $fe ;
   y[1] := $fe ;
   y[2] := $fe ;
   y[3] := $fe ;
   y[4] := $68 ;
   y[5] := $99 ;
   y[6] := $99 ;
   y[7] := $99 ;
   y[8] := $99 ;
   y[9] := $99 ;
   y[10] := $99 ;
   y[11] := $68 ;
   y[12] := $1 ;
   y[13] := $2 ;
   y[14] := $2F + $33 ;
   y[15] := $B6 + $33 ;

   x := 0 ;
   for i := 4 to 15 do
       x := x + y[i] ;

   y[16] := x mod 256 ;
   y[17] := $16 ;

   for i := 0 to ChatServerSocket.Socket.ActiveConnections - 1 do
     begin
      if ChatServerSocket.Socket.Connections[i].RemoteAddress <> clientip.Text then
        ChatServerSocket.Socket.Connections[i].SendBuf(y,18) ;
     end ;
end;
procedure TForm_Server_Main.EB63F ;
var i , x : Integer ;
    y :array[0..17] of byte ;
begin
   y[0] := $fe ;
   y[1] := $fe ;
   y[2] := $fe ;
   y[3] := $fe ;
   y[4] := $68 ;
   y[5] := $99 ;
   y[6] := $99 ;
   y[7] := $99 ;
   y[8] := $99 ;
   y[9] := $99 ;
   y[10] := $99 ;
   y[11] := $68 ;
   y[12] := $1 ;
   y[13] := $2 ;
   y[14] := $3F + $33 ;
   y[15] := $B6 + $33 ;

   x := 0 ;
   for i := 4 to 15 do
       x := x + y[i] ;

   y[16] := x mod 256 ;
   y[17] := $16 ;

   for i := 0 to ChatServerSocket.Socket.ActiveConnections - 1 do
     begin
      if ChatServerSocket.Socket.Connections[i].RemoteAddress <> clientip.Text then
        ChatServerSocket.Socket.Connections[i].SendBuf(y,18) ;
     end ;
end;

procedure TForm_Server_Main.E911E ;
var i , x : Integer ;
    y :array[0..17] of byte ;
begin
   y[0] := $fe ;
   y[1] := $fe ;
   y[2] := $fe ;
   y[3] := $fe ;
   y[4] := $68 ;
   y[5] := $99 ;
   y[6] := $99 ;
   y[7] := $99 ;
   y[8] := $99 ;
   y[9] := $99 ;
   y[10] := $99 ;
   y[11] := $68 ;
   y[12] := $1 ;
   y[13] := $2 ;
   y[14] := $1e + $33 ;
   y[15] := $91 + $33 ;

   x := 0 ;
   for i := 4 to 15 do
       x := x + y[i] ;

   y[16] := x mod 256 ;
   y[17] := $16 ;

   for i := 0 to ChatServerSocket.Socket.ActiveConnections - 1 do
     begin
      if ChatServerSocket.Socket.Connections[i].RemoteAddress <> clientip.Text then
        ChatServerSocket.Socket.Connections[i].SendBuf(y,18) ;
     end ;
end;
procedure TForm_Server_Main.E912E ;
var i , x : Integer ;
    y :array[0..17] of byte ;
begin
   y[0] := $fe ;
   y[1] := $fe ;
   y[2] := $fe ;
   y[3] := $fe ;
   y[4] := $68 ;
   y[5] := $99 ;
   y[6] := $99 ;
   y[7] := $99 ;
   y[8] := $99 ;
   y[9] := $99 ;
   y[10] := $99 ;
   y[11] := $68 ;
   y[12] := $1 ;
   y[13] := $2 ;
   y[14] := $2e + $33 ;
   y[15] := $91 + $33 ;

   x := 0 ;
   for i := 4 to 15 do
       x := x + y[i] ;

   y[16] := x mod 256 ;
   y[17] := $16 ;

   for i := 0 to ChatServerSocket.Socket.ActiveConnections - 1 do
     begin