Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Data unit in a dll

Status
Not open for further replies.

sggaunt

Programmer
Jul 4, 2001
8,620
GB
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.

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.

Steve [The sane]: Delphi a feersum engin indeed.
 
Just one line of code missing it would seem!!

Code:
 DataModule1 := TDataModule1.Create(nil);





Steve [The sane]: Delphi a feersum engin indeed.
 
and it should be freed on exit!
But there are still problems in that I cant send or receive any messages (Thought my firewall triggers indicating activity)

Steve [The sane]: Delphi a feersum engin indeed.
 
Sorry to bump this guys. But days of web serching and trying to locate a difference between the normal version of netchat and my dll version has got me nowhere at all.
Desperatly need some clues with this one.


Steve [The sane]: Delphi a feersum engin indeed.
 
steve,
can you show me the app that loads the dll?

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!
 
Yes here it is.

Code:
unit test;

interface

uses
  {fastmm4,} Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, registry, ExtCtrls;

 type
  TForm1 = class(TForm)
    Button1: TButton;
    MessageBox: TEdit;
    Button2: TButton;
    Address: TEdit;
    LocalPort: TEdit;
    Remoteport: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    SetupBtn: TButton;
    Closebtn: TButton;
    ReadBtn: TButton;
    StopBtn: TButton;
    SendBtn: TButton;
    getSetsBtn: TButton;
    Label4: TLabel;
    OutputBox: TEdit;
    SelectSetting: TComboBox;
    Label5: TLabel;
    Label6: TLabel;
    RemCount: TLabel;
    IPCheck: TTimer;
    Label7: TLabel;
    BSent: TLabel;
    Label8: TLabel;
    CBrxd: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Sbrxd: TLabel;
    SBsent: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SetupBtnClick(Sender: TObject);
    procedure ClosebtnClick(Sender: TObject);
    procedure ReadBtnClick(Sender: TObject);
    procedure SendBtnClick(Sender: TObject);
    procedure getSetsBtnClick(Sender: TObject);
    procedure StopBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure IPCheckTimer(Sender: TObject);
  private
      { Private declarations }
      procedure ReadRegistry;
      procedure WriteRegistry;

  public
      FIniFile: TReginiFile;
  end;


  // DLL Function calls
  function SayHello: shortstring; stdcall; external 'hellow';
  function Maximum(X, Y: Integer): Integer; stdcall; external 'Ethernet';
  function Initalise: integer; stdcall; external 'Ethernet';
  function ActivateServer(LocalP: shortstring;
                          RemoteH: shortstring;
                          RemoteP: shortstring): integer; stdcall; external 'Ethernet';
  function Send(S: shortstring;
                 RemoteH: shortstring;
                 RemoteP: shortstring): integer; stdcall; external 'Ethernet';

  function ReadLine: shortstring; stdcall; external 'Ethernet';
  function RetrieveSettings(Code: integer): shortstring; stdcall; external 'Ethernet';
  function StopAll: integer; stdcall; external 'Ethernet';
  function ReadCount: integer; stdcall; external 'Ethernet';    // read the number of lines of recived text stored
  function ClientBytesSent: integer; stdcall; external 'Ethernet';
  function ClientBytesRxd: integer; stdcall; external 'Ethernet';
  function ServerBytesSent: integer; stdcall; external 'Ethernet';
  function ServerBytesRxd: integer; stdcall; external 'Ethernet';



var
  Form1: TForm1;


const
 SECTION = 'Intrex\Lantest';

implementation
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  try
     if Initalise > 0 then
       showmessage('Initalisation Error')
     else
       MessageBox.Text := 'Init OK';
  except
     showmessage('Error in Dll');
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   try
      MessageBox.Text := inttostr(Maximum(10,20));
   except
       showmessage('Error in Dll');
   end;
end;

procedure TForm1.SetupBtnClick(Sender: TObject);
begin
  if ActivateServer(LocalPort.Text, Address.Text, RemotePort.Text) = 0 then
      MessageBox.Text := 'Server active';
  IpCheck.Enabled := true;
end;

procedure TForm1.ClosebtnClick(Sender: TObject);
begin
  ipcheck.Enabled := false;
  close
end;

procedure TForm1.ReadBtnClick(Sender: TObject);
begin
  MessageBox.Text := ReadLine;
  RemCount.Caption := inttostr(ReadCount);
end;

procedure TForm1.SendBtnClick(Sender: TObject);
begin
   if send(OutputBox.Text, trim(address.Text), trim(remotePort.Text)) = 0 then
       messagebox.Text := 'Client connected';
   BSent.Caption := inttostr(ClientBytesSent);
end;

procedure TForm1.getSetsBtnClick(Sender: TObject);
begin
  MessageBox.Clear;
  MessageBox.Text := RetrieveSettings(SelectSetting.itemindex);
end;

procedure TForm1.StopBtnClick(Sender: TObject);
begin
   ipcheck.Enabled := false;
   if stopall = 0 then
     messagebox.Text := 'Server and Client Stopped'
   else
     messagebox.Text := 'Error Stopping Server and Client';
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  ReadRegistry;
end;

procedure TForm1.ReadRegistry;
begin
    FIniFile := TRegIniFile.Create('Software');
   with FIniFile do
     begin
        Address.Text := ReadString(SECTION, 'Last', '127.0.0.1');
        LocalPort.Text := ReadString(SECTION, 'Local Port', '4000');
        RemotePort.Text := ReadString(SECTION, 'Remote Port', '4000');
       free;
     end;
end;

procedure TForm1.WriteRegistry;
begin
    FIniFile := TRegIniFile.Create('Software');
    with FIniFile do
       begin
         WriteString(SECTION, 'Remote', Address.Text);
         WriteString(SECTION, 'Local Port', LocalPort.Text);
         WriteString(SECTION, 'Remote Port', RemotePort.Text);
         free;
     end;

end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  WriteRegistry;
end;

procedure TForm1.IPCheckTimer(Sender: TObject);
begin
   RemCount.Caption := Inttostr(ReadCount);
   BSent.Caption := inttostr(ClientBytesSent);
   CBRxd.Caption := inttostr(ClientBytesRxd);
   SBSent.Caption := inttostr(ServerBytesSent);
   SbRxd.Caption := inttostr(ServerBytesRxd);
end;

end.

Steve [The sane]: Delphi a feersum engin indeed.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top