农历 2023 年已近尾声,现在才来写这篇文章好像有点晚。本来很犹豫要不要写这篇文章的,但是感觉好像写这么一篇文章也许能帮到大家,遂有此文。

方案调研

Delphi 是 21 世纪初很流行的一种编程工具。它以 Pascal 为基础,发展出了面向对象的系列语法,形成了一套 Object Pascal 生态。

但 Microsoft 似乎不允许另一家公司掌握 在 Windows 世界上的软件开发的话语权,同时可能是出于 Visual 系列开发工具盈利的需要,Microsoft 在系列竞争中绞杀了 Delphi 背后的 Borland 公司,于是 Delphi 渐渐没落了。Lazarus 生态则是 Delphi 的开源替代品,继承了 Delphi,但又不完全是 Delphi。

讲了这么多背景,其实就是想吐槽下,Delphi也好,Free Pascal / Lazarus 也好,真的还停留在上个时代对桌面应用软件的理解。对于网络的支持真的真的非常薄弱,远远达不到今天很多语言的水平。

这也导致了,在 Free Pascal / Lazarus 生态下,写一个 Socket Client 真的是相当之坑。如果还有下次,我绝对不会用 Pascal 来做网络客户端或者服务端了……

大概搜索了下,Free Pascal 搞个 Socket Client,基本上就 Indy库 和 FP内置的Sockets 两个选项。

Indy库要额外引入三方库,不如就 FP内置的Sockets 好了。

踩坑

照着官方文档很快就搞了个版本,但是发现居然不能过编译。官网的文档居然是错的……

官网的文档用的 Connect() 这个函数在 Sockets 里面压根找不到……

网上论坛里给的这个 TCP Socket 程序貌似可以用,但是缺少了DNS解析等等流程。

于是对着 C TCP Socket 标程查漏补缺,一顿搜素,找到了 resolve 库以及 THostResolver 类。

又一通自作聪明地 照着 C Socket 标程用 fpWrite/fpRead 函数换了 fpSend/fpRecv 函数,结果发现 fpWrite/fpRead 这组函数又是坏的……

顺着 Lazarus 找到 Sockets 库里面的定义,发现实际上这货就是把 winsock 拿来封装了一波。不知道是不是有谁曾想一展宏图把 Sockets 和 Pascal 内建的输入输出接起来,但是因为某些原因最后作罢了,所以搞了个半成品 Connect() 丢在文档里……

实现

function ValidateAndParseServerAddress(raw_addr: ansistring; var addr: string; var port: integer): boolean;
var
  port_str: string;
  stage: integer;
  i: longint;
begin
  stage := 0;
  ValidateAndParseServerAddress := false;
  addr := '';
  port_str := '';
  port := 0;
  for i:=1 to length(raw_addr) do
  begin
    case raw_addr[i] of
      ':': inc(stage);
    else
      case stage of
        0: addr += raw_addr[i];
        1: port_str += raw_addr[i];
      else
        exit;
      end;
    end
  end;
  if stage < 1 then exit;
  port := strtoint(port_str);
  if (port < 0) or (port > 65535) then exit;
  ValidateAndParseServerAddress := true;
end;

function GetHostByName(host_name:String):String;
var
  host:THostResolver;
begin
  host := THostResolver.Create(nil);
  if host.NameLookup(host_name) then
     result := host.AddressAsString
   else
     result := '';
  host.Free;
end;

function GetRedpackInfo(server_addr_raw: ansistring; var redpack1, redpack2: longint; var valid1, valid2: boolean): boolean;
var
  server_addr: string;
  server_port: integer;
  host_entry: string;
  fp_socket_fd: longint;
  saddr: TSockAddr;
  buf: TBuffer;
begin
  GetRedpackInfo := false;
  if not ValidateAndParseServerAddress(server_addr_raw, server_addr, server_port) then
  begin
    showMessage('服务器地址非法');
    exit;
  end;
  host_entry := GetHostByName(server_addr);
  fp_socket_fd := fpSocket(AF_INET, SOCK_STREAM, 0);
  if fp_socket_fd < 0 then
  begin
    showMessage('创建 Socket 失败');
    exit;
  end;
  saddr.sin_family := AF_INET;
  saddr.sin_port := htons(server_port);
  saddr.sin_addr := StrToNetAddr(host_entry);
  if fpConnect(fp_socket_fd, @saddr, sizeof(saddr)) <> 0 then
  begin
     showMessage('连接服务器失败');
     CloseSocket(fp_socket_fd);
     exit;
  end;
  BuildModbusReadCmd(buf, 1, 0, 0, 3);
  fpSend(fp_socket_fd, @buf, 12, 0);
  fpRecv(fp_socket_fd, @buf, 255, 0);
  if not ParseModbusRedpackReadResp(buf, redpack1, valid1) then
  begin
     showMessage('无法解析Modbus数据包');
     CloseSocket(fp_socket_fd);
     exit;
  end;
  BuildModbusReadCmd(buf, 3, 1, 0, 3);
  fpSend(fp_socket_fd, @buf, 12, 0);
  fpRecv(fp_socket_fd, @buf, 255, 0);
  if not ParseModbusRedpackReadResp(buf, redpack2, valid2) then
  begin
     showMessage('无法解析Modbus数据包');
     CloseSocket(fp_socket_fd);
     exit;
  end;
  CloseSocket(fp_socket_fd);
  GetRedpackInfo := true;
end;

ParseModbusRedpackReadResp() 这个函数和 Socket Client 的主干无关,我就不给出来了。

结语

2023 年新春红包这个系列这样就算结束了。感谢大家的阅读,谢谢。