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

源码开发语言/平台
当前位置：首页 > 源码/资料 > 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, ExtCtrls;
  9. type
  10.   TCliStatus = (csIdle, csList, csBitmap, csText, csError);
  12.   TForm1 = class(TForm)
  13.     ClientSocket1: TClientSocket;
  14.     cbActivate: TCheckBox;
  15.     EditServer: TEdit;
  16.     Label4: TLabel;
  17.     btnExec: TButton;
  18.     EditServerFile: TEdit;
  19.     Label2: TLabel;
  20.     ListFiles: TListBox;
  21.     Label1: TLabel;
  22.     EditDir: TEdit;
  23.     btnGetDir: TButton;
  24.     LabelDir: TLabel;
  25.     Bevel1: TBevel;
  26.     btnBitmap: TButton;
  27.     btnText: TButton;
  28.     procedure ClientSocket1Connect(Sender: TObject;
  29.       Socket: TCustomWinSocket);
  30.     procedure ClientSocket1Disconnect(Sender: TObject;
  31.       Socket: TCustomWinSocket);
  32.     procedure cbActivateClick(Sender: TObject);
  33.     procedure btnExecClick(Sender: TObject);
  34.     procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
  35.     procedure btnGetDirClick(Sender: TObject);
  36.     procedure ListFilesClick(Sender: TObject);
  37.     procedure btnBitmapClick(Sender: TObject);
  38.     procedure btnTextClick(Sender: TObject);
  39.     procedure FormCreate(Sender: TObject);
  40.   private
  41.     CliStatus: TCliStatus;
  42.     Buffer: array [0..9999] of Char;
  43.   end;
  45. var
  46.   Form1: TForm1;
  48. implementation
  50. {$R *.DFM}
  52. uses
  53.   CliBmp, CliText;
  55. procedure TForm1.ClientSocket1Connect(Sender: TObject;
  56.   Socket: TCustomWinSocket);
  57. begin
  58.   Caption := 'Connected';
  59. end;
  61. procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  62.   Socket: TCustomWinSocket);
  63. begin
  64.   Caption := 'Disconnected';
  65. end;
  67. procedure TForm1.cbActivateClick(Sender: TObject);
  68. begin
  69.   if not ClientSocket1.Active then
  70.     ClientSocket1.Address := EditServer.Text;
  71.   ClientSocket1.Active := cbActivate.Checked;
  72. end;
  74. procedure TForm1.btnExecClick(Sender: TObject);
  75. begin
  76.   ClientSocket1.Socket.SendText ('EXEC!' + EditServerFile.Text);
  77. end;
  79. procedure TForm1.ClientSocket1Read(Sender: TObject;
  80.   Socket: TCustomWinSocket);
  81. var
  82.   strIn: string;
  83.   Stream: TMemoryStream;
  84.   nReceived: Integer;
  85. begin
  86.   case CliStatus of
  87.     // look for data to receive
  88.     csIdle:
  89.     begin
  90.       Socket.ReceiveBuf (Buffer, 5);
  91.       strIn := Copy (Buffer, 1, 5);
  92.       if strIn = 'TEXT!' then
  93.         CliStatus := csText
  94.       else if strIn = 'BITM!' then
  95.         CliStatus := csBitmap
  96.       else if strIn = 'LIST!' then
  97.         CliStatus := csList
  98.       else if strIn = 'ERROR' then
  99.         CliStatus := csError;
  100.     end;
  101.     // show the messages (might actually not be an error)
  102.     csError:
  103.     begin
  104.       ShowMessage (Socket.ReceiveText);
  105.       cliStatus := csIdle;
  106.     end;
  107.     // get a directory listing
  108.     csList:
  109.     begin
  110.       ListFiles.Items.Text := Socket.ReceiveText;
  111.       cliStatus := csIdle;
  112.     end;
  113.     // read a text file
  114.     csText:
  115.     begin
  116.       with TFormText.Create (Application) do
  117.       begin
  118.         Memo1.Text := Socket.ReceiveText;
  119.         Show;
  120.       end;
  121.       cliStatus := csIdle;
  122.     end;
  123.     // read a bitmap file
  124.     csBitmap:
  125.       with TFormBmp.Create (Application) do
  126.       begin
  127.         Stream := TMemoryStream.Create;
  128.         Screen.Cursor := crHourglass;
  129.         try
  130.           while True do
  131.           begin
  132.             nReceived := Socket.ReceiveBuf (Buffer, sizeof (Buffer));
  133.             if nReceived <= 0 then
  134.               Break
  135.             else
  136.               Stream.Write (Buffer, nReceived);
  137.             // delay (200 milliseconds)
  138.             Sleep (200);
  139.           end;
  140.           // reset and load the temporary file
  141.           Stream.Position := 0;
  142.           Image1.Picture.Bitmap.LoadFromStream (Stream);
  143.         finally
  144.           Stream.Free;
  145.           Screen.Cursor := crDefault;
  146.         end;
  147.         Show;
  148.       cliStatus := csIdle;
  149.       end;
  150.   end; // case
  151. end;
  153. procedure TForm1.btnGetDirClick(Sender: TObject);
  154. begin
  155.   ClientSocket1.Socket.SendText ('LIST!' + EditDir.Text);
  156.   LabelDir.Caption := EditDir.Text;
  157. end;
  159. procedure TForm1.ListFilesClick(Sender: TObject);
  160. begin
  161.   EditServerFile.Text := LabelDir.Caption + '' +
  162.     ListFiles.Items [ListFiles.ItemIndex];
  163. end;
  165. procedure TForm1.btnBitmapClick(Sender: TObject);
  166. begin
  167.   ClientSocket1.Socket.SendText ('BITM!' + EditServerFile.Text);
  168. end;
  170. procedure TForm1.btnTextClick(Sender: TObject);
  171. begin
  172.   ClientSocket1.Socket.SendText ('TEXT!' + EditServerFile.Text);
  173. end;
  175. procedure TForm1.FormCreate(Sender: TObject);
  176. begin
  177.   CliStatus := csIdle;
  178. end;
  180. end.
  181.