Некорректная работа в DLL

[Shouldercannon]

Наработки
Project1

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  // Поток для работы с DLL 
  TShowServerInfo_Thread = class(TThread)
  private
  { Private declarations }
  public
  protected
    procedure Execute; override;
  end;

var
  Form1: TForm1;
  ServerInfoWindows: Integer;
  ServerInfoHandels: THandle;

implementation

{$R *.dfm}

procedure ServerInfo_Show;
var
  ShowInfo: procedure(Win: Integer); stdcall;
  FormClosed: function(Win: Integer): Integer;
  SetMainFrmHandle: procedure(SAppHandle, SAppFormHandle: THandle); stdcall;
  Win: Integer;
begin
  if ServerInfoWindows = 0 then ServerInfoHandels := LoadLibrary(PChar(ExtractFilePath(Application.ExeName) + 'dll\dll.dll'));
  if ServerInfoHandels >= 32 then
  begin
    @ShowInfo := GetProcAddress(ServerInfoHandels, 'ShowInfo');
    @FormClosed := GetProcAddress(ServerInfoHandels, 'FormClosed');
    @SetMainFrmHandle := GetProcAddress(ServerInfoHandels, 'SetMainFrmHandle');
    if (@SetMainFrmHandle <> nil) then SetMainFrmHandle(Application.Handle, Form1.Handle);
    if (@ShowInfo <> nil) and (@FormClosed <> nil) then
    begin
      Inc(ServerInfoWindows);
      Win := ServerInfoWindows;
      ShowInfo(Win);
      while FormClosed(Win) = 0 do
      begin
        Sleep(10);
        Application.ProcessMessages;
      end;
      while FormClosed(Win) = 0 do Sleep(50);
      Dec(ServerInfoWindows);
      if ServerInfoWindows = 0 then FreeLibrary(ServerInfoHandels);
    end;
  end;
end;

procedure ServerInfo_ShowThread;
var
  ShowInfoThread: TShowServerInfo_Thread;
begin
  ShowInfoThread := TShowServerInfo_Thread.Create(True);
  ShowInfoThread.FreeOnTerminate := True;
  ShowInfoThread.Resume;
end;

procedure TShowServerInfo_Thread.Execute;
begin
  FreeOnTerminate := True;
  ServerInfo_Show;
  Terminate;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ServerInfo_ShowThread;
end;

end.

DLL

library dll;

uses
  SysUtils,
  Windows,
  Dialogs,
  Controls,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

procedure ShowInfo(Win: Integer); stdcall;
begin
  Form1[Win] := TForm1.Create(nil);
  Form1[Win].Show;
end;

function FormClosed(Win: Integer): Integer;
begin
  if not Form1[Win].Visible then
  begin
    Form1[Win].Release;
    Result := 1;
  end
  else Result := 0;
end;

exports
  ShowInfo, FormClosed;

begin
end.

[Shouldercannon]

Unit1

unit unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

const
  MY_MESS = WM_USER + 105;
  MY_DOWNLOADER_WORK_END_MESS = WM_USER + 106;

type
  PMyProgressData = ^TMyProgressData;
  TMyProgressData = record
    Bar: TProgressBar;
    Status: Integer;
    Max: Integer;
    Progress: Integer;
   end;

type
  TForm1 = class(TForm)
    Image1: TImage;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    ProgressBar1: TProgressBar;
    Button1: TButton;
    Panel1: TPanel;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure MyProgress(var msg: TMessage); message MY_MESS;
    procedure MyDownloaderWorkEndMessage(var msg: TMessage); message MY_DOWNLOADER_WORK_END_MESS;
  public
    { Public declarations }
  end;

  TDownLoader_Thread = class(TThread)
  private
    { Private declarations }
    Bool: Boolean;
    FProgressData: TMyProgressData;
    procedure SetProgressBar(const Value: TProgressBar);
    procedure HTTPWork(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure HTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
  protected
    procedure Execute; override;
    procedure DoTerminate; override;
    procedure SyncProc;
  public
    GoButton: TButton;
    TargetWin: HWND;
    property ProgressBar: TProgressBar write SetProgressBar;
  end;

var
  Form1: Array[1..100] of TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_APPWINDOW);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  DownLoader_Thread: TDownLoader_Thread;
begin
  Button2.Visible := False;

  DownLoader_Thread := TDownLoader_Thread.Create(True);
  DownLoader_Thread.ProgressBar := ProgressBar1;
  DownLoader_Thread.GoButton := Button2;
  DownLoader_Thread.TargetWin := Self.Handle;
  DownLoader_Thread.FreeOnTerminate := True;
  DownLoader_Thread.Resume;
end;

procedure TDownLoader_Thread.Execute;
var
  HTTP: TIdHTTP;
  MS: TMemoryStream;
begin
  Bool := True;

  HTTP := TIdHTTP.Create(nil);
  MS := TMemoryStream.Create;
  try
    HTTP.OnWork := HTTPWork;
    HTTP.OnWorkBegin := HTTPWorkBegin;
    try
      HTTP.Get('http://rvs.ucoz.ru/2.bmp', MS);
      MS.SaveToFile(ExtractFilePath(Application.ExeName) + '2.bmp');
    except
      Bool := False;
    end;
  finally
    HTTP.Free;
    MS.Free;
  end;
end;

procedure TDownLoader_Thread.DoTerminate;
begin
  // Что-то... Если нужно до вызова внешнего OnTerminate (если назначен)
  inherited;
  // Что-то... Если нужно после вызова внешнего OnTerminate (если назначен)
  Synchronize(SyncProc); // Если закоментировать, то ниже следующее событие произойдёт

  if Bool then PostMessage(TargetWin, MY_DOWNLOADER_WORK_END_MESS, 1, 0) else PostMessage(TargetWin, MY_DOWNLOADER_WORK_END_MESS, 0, 0);
end;

procedure TDownLoader_Thread.SyncProc;
begin
  GoButton.Visible := True;
end;

procedure TForm1.MyDownloaderWorkEndMessage(var msg: TMessage);
begin
  if (msg.WParam = 1) then
  begin
    Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + '2.bmp');
  end
  else if (msg.WParam = 0) then
  begin
    MessageBox(0, 'Фаталити', 'Ошибка', MB_ICONError);
  end;
end;

procedure TForm1.MyProgress(var msg: TMessage);
var
  Data: PMyProgressData;
begin
  Integer(Pointer(Data)) := msg.WParam;
  case Data^.Status of
  0: begin
    if (Data^.Bar <> nil) then
    begin
      Data^.Bar.Max := Data^.Max;
      Data^.Bar.Position := msg.LParam;
    end;
  end;
  1: begin
    if (Data^.Bar <> nil) then
    Data^.Bar.Position := Data^.Progress;
  end;

  end;
end;

procedure TDownLoader_Thread.SetProgressBar(const Value: TProgressBar);
begin
  ZeroMemory(@FProgressData, SizeOf(TMyProgressData));
  FProgressData.Bar := Value;
end;

procedure TDownLoader_Thread.HTTPWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  FProgressData.Status := 1;
  FProgressData.Progress := AWorkCount;
  PostMessage(TargetWin, MY_MESS, WParam(@FProgressData), 0);
end;

procedure TDownLoader_Thread.HTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  FProgressData.Status := 0;
  FProgressData.Max := AWorkCountMax;
  PostMessage(TargetWin, MY_MESS, WParam(@FProgressData), 0);
end;

end.

[Shouldercannon]

1. В DoTerminate выполняется только одно событие
2. Прогресс бар при последующих закачках не двигается и вообще неправильно показывает прогресс
3. Нулевая реакция на синхронизацию (написанные там события не выполняются)

Тоже самое без вне DLL работает Великолепно.

[3D Hunter]

1. Первая ошибка: в DLL проекте нужно писать в конце заголовка каждого экспортируемого метода stdcall; export;

procedure GetParserInfo(out AFullType,AShortType:PAnsiChar); stdcall; export;

2. Какого еще внешнего или внутреннего DoTerminate? Откуда вы взяли inherited в OnTerminate? Убрать inherited.
3. ПрогрессБар не работает потому, что вы обращаетесь к нему без синхронизации: меняете свойства компонента Data^.Bar в методах потока. Вызова синхронайза, кроме Synchronize(SyncProc), я не увидел нигде.

[Пепел Феникса]

1)stdcall не обязательно.(но должно быть одинакого что в импорте что в экспорте указано)
насчет export видимо по удобству, так как есть список exports.

[evg_m]

  PostMessage(TargetWin, MY_MESS, WParam(@FProgressData), 0);

предполагает

var
  Data: PMyProgressData;
begin
  Data := Pointer(msg.WParam);

но лучше убрать из TMyProgressData = record
// Bar: TProgressBar;
Status: Integer;
Max: Integer;
Progress: Integer;
end;
от том как (с помощью чего) отображать голова должна болеть (надо знать) только самой форме(получателю сообщения).
и соответственно из потока все связанное с оным.

  // Что-то... Если нужно после вызова внешнего OnTerminate (если назначен)
  Synchronize(SyncProc); // Если закоментировать, то ниже следующее событие произойдёт

  if Bool then PostMessage(TargetWin, MY_DOWNLOADER_WORK_END_MESS, 1, 0) else PostMessage(TargetWin, MY_DOWNLOADER_WORK_END_MESS, 0, 0);

А почему бы все это не делать в том самом Внешнем OnTerminate

procedure TForm1.OnterminateThread(sender: TObject);
begin
  (sender as TMyThread).Gobutton,visivle:=true;
//
end;