repos_ecs/hp-socket/HP-Socket/Demo/Other Languages Demos/Delphi/Server/Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,HPSocketSDKUnit, ExtCtrls;

type
  TForm1 = class(TForm)
    lst: TListBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    btn1: TButton;
    btn2: TButton;
    Label3: TLabel;
    Label4: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  Pserver = Record
    DListener : Integer;
    DServer : Integer;
  end;

var
  Form1: TForm1;
  PPserver: pserver;
  cs:TRTLCriticalSection;
implementation

{$R *.dfm}
procedure AddMsg(str: string);
begin
  EnterCriticalSection(CS);
  Form1.lst.Items.Add('==> '+str);
  LeaveCriticalSection(CS);

end;

function OnPrepareListen(soListen: Pointer): En_HP_HandleResult; stdcall;
begin
    AddMsg('准备监听 -> ' + inttostr(Integer(solisten)));
    Result := HP_HR_OK;
end;

function OnAccept(dwConnId: DWORD; pClient: Pointer): En_HP_HandleResult; stdcall;
var
    ip: array [0 .. 40] of WideChar;
    ipLength: Integer;
    port: Word;
begin
    ipLength := 40;
    if HP_Server_GetRemoteAddress(PPserver.DServer, dwConnId, ip, @ipLength, @port) then
    begin
      AddMsg('连接上线 -> '+  string(ip) +':'+ inttostr(port));
    end
    else
    begin
      AddMsg('取连接信息失败 -> ' + inttostr(dwConnId));
    end;
    Result := HP_HR_OK;
end;

function OnSend(dwConnId: DWORD; const pData: Pointer; iLength: Integer): En_HP_HandleResult; stdcall;
begin
    AddMsg('发送数据 -> ' + inttostr(iLength) + ' bytes');
    Result := HP_HR_OK;
end;

function OnReceive(dwConnID: HP_CONNID;const pData: Pointer; iLength: Integer): En_HP_HandleResult; stdcall;
begin
     AddMsg('收到数据 -> ' + inttostr(iLength) + ' bytes');
     Result:= HP_HR_OK;
end;

function OnCloseConn(dwConnId: DWORD; enOperation: En_HP_SocketOperation; iErrorCode: Integer ): En_HP_HandleResult; stdcall;
begin
    AddMsg('连接关闭 -> ' + inttostr(Integer(dwConnId)));
    Result := HP_HR_OK;
end;

function OnShutdown(): En_HP_HandleResult; stdcall;
begin
    AddMsg('服务关闭 -> ');
    Result:= HP_HR_OK;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     // 创建监听器对象
    PPserver.DListener:= Create_HP_TcpServerListener();

    // 创建 Socket 对象
    PPserver.DServer := Create_HP_TcpServer(PPserver.DListener);

    // 设置 Socket 监听器回调函数
    HP_Set_FN_Server_OnPrepareListen(PPserver.DListener, OnPrepareListen);
    HP_Set_FN_Server_OnAccept(PPserver.DListener, OnAccept);
    HP_Set_FN_Server_OnSend(PPserver.DListener, OnSend);
    HP_Set_FN_Server_OnReceive(PPserver.DListener, OnReceive);
    HP_Set_FN_Server_OnClose(PPserver.DListener, OnCloseConn);
    HP_Set_FN_Server_OnShutdown(PPserver.DListener, OnShutdown);

    // 设置HP模式为并发发送模式
    HP_Server_SetSendPolicy(PPserver.DServer, HP_SP_DIRECT);

    //设置工作线程
    HP_Server_SetWorkerThreadCount(PPserver.DServer, 30);

    //初始化临界区
    InitializeCriticalSection(CS);

    AddMsg('系统初始化完成');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteCriticalSection(CS);   //删除临界区
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  Ip:WideString;
  Port:Word;
  errorId: En_HP_SocketError;
  errorMsg: WideString;
begin
    Ip := EDIT1.Text;
    Port := StrToInt(Edit2.TEXT);

    if HP_Server_Start(PPserver.DServer, ip, port) then
    begin
      AddMsg(Format('服务启动成功 -> (%s:%d)', [ip, port]));
    end
    else
    begin
        errorId := HP_Server_GetLastError(PPserver.DServer);
        errorMsg := HP_Server_GetLastErrorDesc(PPserver.DServer);
        AddMsg(Format('服务启动失败 -> %s(%d)', [errorMsg, Integer(errorId)]));
    end;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  if HP_Server_Stop(PPserver.DServer) then
  begin
    AddMsg('服务停止成功 -> ');
  end
  else
  begin
    AddMsg('服务停止失败 -> ');
  end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Count:Integer;
begin
    Count:= HP_Server_GetConnectionCount(PPserver.DServer);
    Label4.Caption:= IntToStr(Count);
end;

end.