开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
ServerForm.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：3k
源码类别：

Delphi控件源码

开发平台：

Delphi

ServerForm.pas：源码内容
  1. unit ServerForm;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ScktComp, StdCtrls, Grids, DBGrids, Db, DBTables, ComCtrls;
  9. const
  10.   wm_RefreshClients = wm_User;
  12. type
  13.   TForm1 = class(TForm)
  14.     PageControl1: TPageControl;
  15.     TabSheet1: TTabSheet;
  16.     TabSheet2: TTabSheet;
  17.     Label1: TLabel;
  18.     lbClients: TListBox;
  19.     lbLog: TListBox;
  20.     ServerSocket1: TServerSocket;
  21.     Table1: TTable;
  22.     DataSource1: TDataSource;
  23.     DBGrid1: TDBGrid;
  24.     Table1Company: TStringField;
  25.     Table1CompID: TFloatField;
  26.     Table1Address: TStringField;
  27.     Table1State: TStringField;
  28.     Table1Country: TStringField;
  29.     Table1Email: TStringField;
  30.     Table1Contact: TStringField;
  31.     Table1LoggedBy: TStringField;
  32.     Table1LoggetOn: TDateField;
  33.     procedure ServerSocket1ClientConnect(Sender: TObject;
  34.       Socket: TCustomWinSocket);
  35.     procedure ServerSocket1ClientDisconnect(Sender: TObject;
  36.       Socket: TCustomWinSocket);
  37.     procedure FormCreate(Sender: TObject);
  38.     procedure ServerSocket1ClientRead(Sender: TObject;
  39.       Socket: TCustomWinSocket);
  40.   private
  41.     { Private declarations }
  42.   public
  43.     procedure RefreshClients (var Msg: TMessage);
  44.       message wm_RefreshClients;
  45.   end;
  47. var
  48.   Form1: TForm1;
  50. implementation
  52. {$R *.DFM}
  54. procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  55.   Socket: TCustomWinSocket);
  56. begin
  57.   lbLog.Items.Add ('Connected: ' +
  58.     Socket.RemoteHost + ' (' +
  59.     Socket.RemoteAddress + ')' );
  60.   PostMessage (Handle, wm_RefreshClients, 0, 0);
  61. end;
  63. procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  64.   Socket: TCustomWinSocket);
  65. begin
  66.   lbLog.Items.Add ('Disconnected: ' +
  67.     Socket.RemoteHost + ' (' +
  68.     Socket.RemoteAddress + ')' );
  69.   PostMessage (Handle, wm_RefreshClients, 0, 0);
  70. end;
  72. procedure TForm1.RefreshClients;
  73. var
  74.   I: Integer;
  75. begin
  76.   lbClients.Clear;
  77.   for I := 0 to ServerSocket1.Socket.ActiveConnections - 1 do
  78.     with ServerSocket1.Socket.Connections [I] do
  79.       lbClients.Items.Add (
  80.         RemoteAddress + ' (' + RemoteHost + ')');
  81. end;
  83. procedure TForm1.FormCreate(Sender: TObject);
  84. begin
  85.   // use a table in the current directory
  86.   Table1.DatabaseName :=
  87.     ExtractFilePath (Application.ExeName);
  88.   // create the table, if it doens't exist
  89.   if not Table1.Exists then
  90.     Table1.CreateTable;
  91.   Table1.Active := True;
  92. end;
  94. procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  95.   Socket: TCustomWinSocket);
  96. var
  97.   strCommand: string;
  98.   strFeedback: string;
  99.   Data: TStringList;
  100.   I: Integer;
  101. begin
  102.   // read from the client
  103.   strCommand := Socket.ReceiveText;
  104.   lbLog.Items.Add (strCommand);
  106.   // reassemble the data
  107.   Data := TStringList.Create;
  108.   try
  109.     Data.Text := strCommand;
  110.     // new record
  111.     Table1.Insert;
  112.     // set the fields using the strings
  113.     for I := 0 to Table1.FieldCount - 1 do
  114.       Table1.Fields [I].AsString :=
  115.         Data.Values [Table1.Fields[I].FieldName];
  116.     // complete with random ID, sender, and date
  117.     Table1CompID.AsInteger := GetTickCount;
  118.     Table1LoggedBy.AsString := Socket.RemoteAddress;
  119.     Table1LoggetOn.AsDateTime := Date;
  120.     Table1.Post;
  122.     // get the value to return
  123.     strFeedback := Table1CompID.AsString;
  125.     // send results back
  126.     lbLog.Items.Add (strFeedback);
  127.     Socket.SendText (strFeedback);
  128.   finally
  129.     Data.Free;
  130.   end;
  131. end;
  133. end.