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

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

Delphi控件源码

开发平台：

Delphi

ServerForm.pas：源码内容
  1. unit ServerForm;
  3. interface
  5. {$WARN UNIT_PLATFORM OFF}
  7. uses
  8.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  9.   ScktComp, StdCtrls, FileCtrl;
  11. const
  12.   wm_RefreshClients = wm_User;
  14. type
  15.   TForm1 = class(TForm)
  16.     ServerSocket1: TServerSocket;
  17.     lbClients: TListBox;
  18.     Label1: TLabel;
  19.     Label2: TLabel;
  20.     lbLog: TListBox;
  21.     FileListBox1: TFileListBox;
  22.     procedure ServerSocket1ClientConnect(Sender: TObject;
  23.       Socket: TCustomWinSocket);
  24.     procedure ServerSocket1ClientDisconnect(Sender: TObject;
  25.       Socket: TCustomWinSocket);
  26.     procedure ServerSocket1ClientRead(Sender: TObject;
  27.       Socket: TCustomWinSocket);
  28.   public
  29.     procedure RefreshClients (var Msg: TMessage);
  30.       message wm_RefreshClients;
  31.   end;
  33. var
  34.   Form1: TForm1;
  36. implementation
  38. {$R *.DFM}
  40. procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  41.   Socket: TCustomWinSocket);
  42. begin
  43.   lbLog.Items.Add ('Connected: ' +
  44.     Socket.RemoteHost + ' (' +
  45.     Socket.RemoteAddress + ')' );
  46. end;
  48. procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  49.   Socket: TCustomWinSocket);
  50. begin
  51.   lbLog.Items.Add ('Disconnected: ' +
  52.     Socket.RemoteHost + ' (' +
  53.     Socket.RemoteAddress + ')' );
  54. end;
  56. procedure TForm1.RefreshClients;
  57. begin
  58. end;
  60. procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  61.   Socket: TCustomWinSocket);
  62. var
  63.   strCommand, strFile, strFeedback: string;
  64. begin
  65.   // read from the client
  66.   strCommand := Socket.ReceiveText;
  67.   lbLog.Items.Add ('Client: ' + Socket.RemoteAddress + ': ' +
  68.     strCommand);
  69.   // extract the file name (all commands have 5 characters)
  70.   strFile := Copy (strCommand, 6, Length (strCommand) - 5);
  72.   // execute program
  73.   if Pos ('EXEC!', strCommand) = 1 then
  74.   begin
  75.     if FileExists (strFile) and (
  76.         WinExec (pChar (strFile), sw_ShowNormal) > 31) then
  77.       strFeedback := 'ERROR' + strFile + ' activated'
  78.     else
  79.       strFeedback := 'ERROR' + strFile + ' not found';
  80.     Socket.SendText (strFeedback);
  81.   end
  82.   
  83.   // send back a text file
  84.   else if Pos ('TEXT!', strCommand) = 1 then
  85.   begin
  86.     if FileExists (strFile) then
  87.     begin
  88.       strFeedback := 'TEXT!';
  89.       Socket.SendText (strFeedback);
  90.       Socket.SendStream (TFileStream.Create (
  91.         strFile, fmOpenRead or fmShareDenyWrite));
  92.     end
  93.     else
  94.     begin
  95.       strFeedback := 'ERROR' + strFile + ' not found';
  96.       Socket.SendText (strFeedback);
  97.     end;
  98.   end
  100.   // send back a bitmap file
  101.   else if Pos ('BITM!', strCommand) = 1 then
  102.   begin
  103.     if FileExists (strFile) then
  104.     begin
  105.       strFeedback := 'BITM!';
  106.       Socket.SendText (strFeedback);
  107.       Socket.SendStream (TFileStream.Create (
  108.         strFile, fmOpenRead or fmShareDenyWrite));
  109.     end
  110.     else
  111.     begin
  112.       strFeedback := 'ERROR' + strFile + ' not found';
  113.       Socket.SendText (strFeedback);
  114.     end;
  115.   end
  117.   // send back a directory listing
  118.   else if Pos ('LIST!', strCommand) = 1 then
  119.   begin
  120.     if DirectoryExists (strFile) then
  121.     begin
  122.       strFeedback := 'LIST!';
  123.       Socket.SendText (strFeedback);
  124.       FileListBox1.Directory := strFile;
  125.       Socket.SendText (FileListBox1.Items.Text);
  126.     end
  127.     else
  128.     begin
  129.       strFeedback := 'ERROR' + strFile + ' not found';
  130.       Socket.SendText (strFeedback);
  131.     end;
  132.   end
  133.   else
  134.   begin
  135.     strFeedback := 'ERROR' + 'Undefined command: ' + strCommand;
  136.     Socket.SendText (strFeedback);
  137.   end;
  139.   // log result
  140.   lbLog.Items.Add (strFeedback);
  141. end;
  143. end.