sggaunt

The following code is an attempt to put the Delphi7 demo application Delphi7/demos/Internet/netchat/netchat.dpr
into a dll

I have used the dll wizard to set up the library code and then added a data unit to it.
The data unit includes the
TTcpServer and TTcpClient components from the Internet tab.
any attempt to access the Client or Server componets via the dll just causes a hang.

I also tried it with fastmem4 removed and tried starting a timer on the datamodule all with the same result.


As you can see I have attempted to include fastmm4 (correctly?)
and the string list which is meant to replace the memo in the demo seems to work OK (i.e I can read and write to it via

the dll).



CODE
library Ethernet;
{ To avoid using sharemempass string information using PChar or ShortString parameters. }
uses
FastMM4 in 'FastMM4.pas',
SysUtils,
Classes,
dataUnit in 'dataUnit.pas' {DataModule1: TDataModule};

{$R *.res}

function Initalise: integer; stdcall;
begin
result := 0;
MemRecv := TStringList.Create; // create a string list to hold recived messages
memrecv.Add('Test line');
end;

function StopAll: integer; stdcall;
begin
result := 0;
try
Freeandnil(Memrecv);
Datamodule1.Server.Active := false;
datamodule1.Client.Active := false;
except
result := 1;
end;
end;

function ActivateServer(LocalP: shortstring;
remoteH: shortstring;
RemoteP: shortstring): integer; stdcall;
begin
result := 0;
with DataModule1 do
try
// any one of these calls cause the app to hang!!
Client.RemoteHost := RemoteH;
Client.RemotePort := RemoteP;
Server.LocalPort := LocalP;
Server.Active := True;
except
result := 1;
end;
end;

// read the first line out of the stringlist and delete it!!
// this works as expeceted.

function ReadLine: shortstring; stdcall;
begin
if MemRecv.Count > 0 then
begin
result := MemRecv.Strings[0];
Memrecv.Delete(0);
end
else
result := 'NO DATA';

end;



This is the data unit code (slightly) amended from the demo code.


CODE
unit dataUnit;

interface

uses
fastmm4, SysUtils, Sockets, ExtCtrls, Classes;

type
TDataModule1 = class(TDataModule)
Server: TTcpServer;
Client: TTcpClient;
procedure ServerAccept(Sender: TObject;
ClientSocket: TCustomIpClient);
private
{ Private declarations }
public
{ Public declarations }
end;

TClientDataThread = class(TThread)
private
public
ListBuffer :TStringList;
TargetList :TStrings;
procedure synchAddDataToControl;
constructor Create(CreateSuspended: Boolean);
procedure Execute; override;
procedure Terminate;
end;

var
DataModule1: TDataModule1;
Memrecv: Tstringlist;
implementation

{$R *.dfm}

//------------- TClientDataThread impl -----------------------------------------
constructor TClientDataThread.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
FreeOnTerminate := true;
ListBuffer := TStringList.Create;
end;

procedure TClientDataThread.Terminate;
begin
ListBuffer.Free;
inherited;
end;

procedure TClientDataThread.Execute;
begin
Synchronize(synchAddDataToControl);
end;

procedure TClientDataThread.synchAddDataToControl;
begin
TargetList.AddStrings(ListBuffer);
end;

//------------- end TClientDataThread impl -------------------------------------


procedure TDataModule1.ServerAccept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
s: string;
DataThread: TClientDataThread;
begin
// create thread
DataThread:= TClientDataThread.Create(true);
// set the TagetList to the output string list.
DataThread.TargetList := memRecv;

// Load the Threads ListBuffer
DataThread.ListBuffer.Add('*** Connection Accepted ***');
DataThread.ListBuffer.Add('Remote Host: ' + ClientSocket.LookupHostName(ClientSocket.RemoteHost) +
' (' + ClientSocket.RemoteHost + ')');
DataThread.ListBuffer.Add('===== Begin message =====');
s := ClientSocket.Receiveln;
while s <> '' do
begin
DataThread.ListBuffer.Add(s);
s := ClientSocket.Receiveln;
end;
DataThread.ListBuffer.Add('===== End of message =====');

// Call Resume which will execute and synch the
// ListBuffer with the TargetList
DataThread.Resume;
end;

end.