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

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

Delphi控件源码

开发平台：

Delphi

ClientForm.pas：源码内容
  1. unit ClientForm;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ScktComp, DBCtrls, ExtCtrls, Db, Mask, DBTables;
  9. type
  10.   TForm1 = class(TForm)
  11.     ClientSocket1: TClientSocket;
  12.     EditServer: TEdit;
  13.     Server: TLabel;
  14.     Table1: TTable;
  15.     Table1Company: TStringField;
  16.     Table1CompID: TFloatField;
  17.     Table1Address: TStringField;
  18.     Table1State: TStringField;
  19.     Table1Country: TStringField;
  20.     Table1Email: TStringField;
  21.     Table1Contact: TStringField;
  22.     Label1: TLabel;
  23.     DBEdit1: TDBEdit;
  24.     DataSource1: TDataSource;
  25.     Label2: TLabel;
  26.     Label3: TLabel;
  27.     DBEdit3: TDBEdit;
  28.     Label4: TLabel;
  29.     DBEdit4: TDBEdit;
  30.     Label5: TLabel;
  31.     DBEdit5: TDBEdit;
  32.     Label6: TLabel;
  33.     DBEdit6: TDBEdit;
  34.     Label7: TLabel;
  35.     DBEdit7: TDBEdit;
  36.     DBNavigator1: TDBNavigator;
  37.     DBText1: TDBText;
  38.     btnSendAll: TButton;
  39.     lbLog: TListBox;
  40.     BtnStop: TButton;
  41.     BtnDelete: TButton;
  42.     Label8: TLabel;
  43.     Bevel1: TBevel;
  44.     procedure btnSendAllClick(Sender: TObject);
  45.     procedure ClientSocket1Connect(Sender: TObject;
  46.       Socket: TCustomWinSocket);
  47.     procedure ClientSocket1Disconnect(Sender: TObject;
  48.       Socket: TCustomWinSocket);
  49.     procedure FormCreate(Sender: TObject);
  50.     procedure BtnStopClick(Sender: TObject);
  51.     procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
  52.     procedure BtnDeleteClick(Sender: TObject);
  53.   private
  54.     { Private declarations }
  55.   public
  56.     fWaiting: Boolean;
  57.   end;
  59. var
  60.   Form1: TForm1;
  62. implementation
  64. {$R *.DFM}
  66. procedure TForm1.btnSendAllClick(Sender: TObject);
  67. var
  68.   Data: TStringList;
  69.   I: Integer;
  70. begin
  71.   // activate the connection
  72.   ClientSocket1.Address := EditServer.Text;
  73.   ClientSocket1.Active := True;
  74.   Application.ProcessMessages;
  75.   // save database data in a string list
  76.   Data := TStringList.Create;
  77.   try
  78.     table1.First;
  79.     while not Table1.Eof do
  80.     begin
  81.       // if the record is still not logged
  82.       if Table1CompID.IsNull or (Table1CompId.AsInteger = 0) then
  83.       begin
  84.         lbLog.Items.Add ('Sending ' + Table1Company.AsString);
  85.         Data.Clear;
  86.         // create strings with structure "FieldName=Value"
  87.         for I := 0 to Table1.FieldCount - 1 do
  88.           Data.Values [Table1.Fields[I].FieldName] :=
  89.             Table1.Fields [I].AsString;
  90.         // send the record
  91.         ClientSocket1.Socket.SendText (Data.Text);
  92.         // wait for reponse
  93.         fWaiting := True;
  94.         while fWaiting do
  95.           Application.ProcessMessages;
  96.       end;
  97.       Table1.Next;
  98.     end;
  99.   finally
  100.     // free the data and close the connection
  101.     Data.Free;
  102.     ClientSocket1.Active := False;
  103.   end;
  104. end;
  106. procedure TForm1.ClientSocket1Connect(Sender: TObject;
  107.   Socket: TCustomWinSocket);
  108. begin
  109.   Caption := 'Connected';
  110. end;
  112. procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  113.   Socket: TCustomWinSocket);
  114. begin
  115.   Caption := 'Disconnected';
  116. end;
  118. procedure TForm1.FormCreate(Sender: TObject);
  119. begin
  120.   fWaiting := False;
  121.   // use a table in the current directory
  122.   Table1.DatabaseName :=
  123.     ExtractFilePath (Application.ExeName);
  124.   // create it if it doesn't exist
  125.   if not Table1.Exists then
  126.     Table1.CreateTable;
  127.   Table1.Active := True;
  128. end;
  130. procedure TForm1.BtnStopClick(Sender: TObject);
  131. begin
  132.   fWaiting := False;
  133. end;
  135. procedure TForm1.ClientSocket1Read(Sender: TObject;
  136.   Socket: TCustomWinSocket);
  137. begin
  138.   if fWaiting then
  139.   begin
  140.     Table1.Edit;
  141.     Table1CompId.AsString := Socket.ReceiveText;
  142.     Table1.Post;
  143.     lbLog.Items.Add (Table1Company.AsString +
  144.       ' logged as ' + Table1CompId.AsString);
  145.     fWaiting := False;
  146.   end;
  147. end;
  149. procedure TForm1.BtnDeleteClick(Sender: TObject);
  150. begin
  151.   table1.First;
  152.   while not Table1.Eof do
  153.   begin
  154.     // if the record is still logged
  155.     if not Table1CompID.IsNull and (Table1CompId.AsInteger <> 0) then
  156.       Table1.Delete;
  157.     Table1.Next;
  158.   end;
  159. end;
  161. end.