Question

怎么通过TClientSocket，dll实现数据回调，delphi

Answer 1

这问题说来说去，就是回调函数怎么应用，帮你写个客户端代码吧。

客户端exe部分

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 Tfunction = function(ReadStr:String;Len:integer):boolean;
type
 TForm1 = class(TForm)
   Button1: TButton;
   Memo1: TMemo;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 exportsDLL    : procedure (AOwner: TComponent;MyTfunction:Tfunction;SevAdd:String;SevPort:integer);stdcall;
 SendStrToSev  : function  (SendStr:string) : Integer;stdcall;
 m_hDllHandle  : THandle;

implementation

{$R *.dfm}
function  CallBack(ReadStr:String;Len:integer):boolean;
begin
 form1.Memo1.Lines.Add('接收数据内容:'+readstr);
 form1.Memo1.Lines.Add('数据长度:'+IntTostr(len));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  try
     if m_hDllHandle = 0 then
        m_hDllHandle := LoadLibrary(Pchar(ExtractFilePath(Application.ExeName)+'Project1.dll'));
     if m_hDllHandle = 0 then
        raise Exception.Create('装载文件dll失败！');

     @exportsDLL := GetProcAddress(m_hDllHandle,pchar('exportsDLL'));
     if @exportsDLl = nil then
         raise Exception.Create('exportsDLl失败！');

     @SendStrToSev := GetProcAddress(m_hDllHandle,pchar('SendStrToSev'));
     if @SendStrToSev =nil then
         raise Exception.Create('SendStrToSev失败！');

     exportsDLl(self,CallBack,'127.0.0.1',5002);
  except

  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 if @SendStrToSev<>nil then
   SendStrToSev('aaaaa');
end;

客户端DLL部分
unit Unit1;

interface
uses Classes,Math, SysUtils,ScktComp;

type
 Tfunction = function(ReadStr:String;Len:integer):boolean;
type
 MyClientSocket= class(TClientSocket)
public
  procedure ClientRead(Sender: TObject;Socket: TCustomWinSocket);
  constructor Create(AOwner:TComponent;SevAdd:String;SevPort:integer);reintroduce;
end;
var
 GvMyClientSocket : MyClientSocket;
 CallBack :Tfunction;

implementation

{ MyClientSocket }

procedure MyClientSocket.ClientRead(Sender: TObject;
 Socket: TCustomWinSocket);
var
  ReadStr: String;
  Len:integer;
begin
  Len := socket.ReceiveLength;
  ReadStr := Socket.ReceiveText;
  CallBack(ReadStr,Len);

end;

constructor MyClientSocket.Create(AOwner: TComponent;SevAdd:String;SevPort:integer);
begin
  inherited Create(AOwner);
  self.OnRead       := self.ClientRead;
  self.Address := SevAdd;
  self.Port    := SevPort;
  self.Open;
end;
procedure exportsDLL(AOwner: TComponent;MyTfunction:Tfunction;SevAdd:String;SevPort:integer);stdcall;
begin
 CallBack :=  MyTfunction;
 if GvMyClientSocket = nil then
 begin
   GvMyClientSocket := MyClientSocket.Create(AOwner,SevAdd,SevPort);
 end else
 begin
   GvMyClientSocket.Close;
   GvMyClientSocket.Free;
   GvMyClientSocket := nil;
   GvMyClientSocket := MyClientSocket.Create(AOwner,SevAdd,SevPort);
 end;

end;
function SendStrToSev(SendStr:string) : Integer;stdcall;
begin
 if GvMyClientSocket <> nil then
   Result := GvMyClientSocket.Socket.SendText(sendStr);

end;

exports
 exportsDLL,SendStrToSev;
end