مشکل در ساخت Unit

[Mask]

با سلام.
در برنامه ای قسمتی از کدم رو میخام در یه unit ی غیر از یونیت اصلی برنامم قرار بدهم.
اما چون این کدها دارای ایونتهایی هستند و در حالت عادی این پروسیجرها در قسمت private فرم پیاده سازی میشه . مجبور شدم که در unit جانبی که نوشته ام. در ابتدا یه کلاس تعریف کنم و در قسمت private این کلاس پروسیجرم رو بنویسم.
اما نمیدونم چرا وقتی این کد ها در unit جانبی قرار گرفتند . از کار افتادند.
نمونه کد رو قرار میدهم :

unit Unit_Usb;

interface

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

procedure StartMonitorUsb;

type
TUSBThread = class(TThread)
protected
procedure Execute; override;
end;

type
TMyUsb = class
private
procedure WndProc(var Msg: TMessage);
procedure WMDEVICECHANGE(var Msg: TMessage); message WM_DEVICECHANGE;
Public

end;

var
StatusUSB:Boolean=false;

USBHandle:Cardinal;
USBDrive:string;

const
DBT_DEVICEARRIVAL = $00008000;
DBT_DEVICEREMOVECOMPLETE = $00008004;
DBT_DEVTYP_VOLUME = $00000002;

type
_DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;
DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;
TDevBroadcastHeader = DEV_BROADCAST_HDR;
PDevBroadcastHeader = ^TDevBroadcastHeader;

type
_DEV_BROADCAST_VOLUME = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: WORD;
end;
DEV_BROADCAST_VOLUME = _DEV_BROADCAST_VOLUME;
TDevBroadcastVolume = DEV_BROADCAST_VOLUME;
PDevBroadcastVolume = ^TDevBroadcastVolume;

implementation

procedure StartMonitorUsb;
var
MyUsb: TMyUsb;
begin
MyUsb := TMyUsb.Create;
try
finally
//MyUsb.Free;
end;
end;

procedure TMyUsb.WMDEVICECHANGE(var Msg: TMessage);
var lpdbhHeader: PDevBroadcastHeader;
lpdbvData: PDevBroadcastVolume;
dwIndex: Integer;
lpszDrive: String;
PUSBThread:TUSBThread;
begin
inherited;
lpdbhHeader:=PDevBroadcastHeader(Msg.lParam);

case Msg.WParam of
DBT_DEVICEARRIVAL : {a USB drive was connected}
begin
if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
lpdbvData:=PDevBroadcastVolume(Msg.lParam);
for dwIndex :=0 to 25 do
begin
if ((lpdbvData^.dbcv_unitmask shr dwIndex) = 1) then
begin
lpszDrive:=lpszDrive+Chr(65+dwIndex)+':';
break;
end;
end;
USBDrive:=lpszDrive;
PUSBThread:=TUSBThread.Create(false);
PUSBThread.FreeOnTerminate:=true;
PUSBThread.Resume;
end;
end;
end;
end;

{ TUSBThread }

procedure TUSBThread.Execute;
begin

ShowMessage('');
inherited;
end;

procedure TMyUsb.WndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_DEVICECHANGE) then
begin
try
WMDeviceChange(Msg);
except
Application.HandleException(Self);
end;
end;
end;

end.
و در فرم شو برنامم هم اینو نوشتم.

procedure TForm1.FormShow(Sender: TObject);
begin
StartMonitorUsb;
end;
ممنونم از راهنماییتون.

[Ananas]

سلام.
خوب چون تو قسمت private تعریف شدن تو یونیت دیگه در دسترس نیستن. اصلا برای چی private تعریف کردید؟ برای همین دیگه.

[Mask]

سلام.
خوب چون تو قسمت private تعریف شدن تو یونیت دیگه در دسترس نیستن. اصلا برای چی private تعریف کردید؟ برای همین دیگه.

ممنون. اما زیاد به حالش فرقی نکرد.
الان تو پابلیک نوشتم. اما بازم خبری نشد.:لبخند:

[Ananas]

اما نمیدونم چرا وقتی این کد ها در unit جانبی قرار گرفتند . از کار افتادند.
از کار افتادن یعنی چی؟ یعنی می نویسیشون ولی کامپایلر ارور میده و نمیشناسه؟ یا چی؟ یا خط قرمز زیرش میکشه؟ شاید یونیت رو به پروژه اضافه نکردین! یا تو قسمت uses ننوشتیشون.

[Mask]

نه بابا اینقدرم حواس پرت نیستم که یوز نکرده باشم.
منظورم اینه که ارور نمیده. اما کار هم نمیده.
روال کلی این یونیت اینه که زمانی که یه فلش به سیستم میزنیم . ایونت WMDEVICECHANGE تحریک میشه و یه ترد ساخته میشه و در اون ترد یه Message نمایش داده میشه.
وقتی که این کدها رو در یونیت اصلی برنامه قرار میدم کار میکنه ، اما وقتی میزارمش تو یه یونیت جدا ، از کار میوفته.

[Felony]

به قول علی آقا ؛ عجیبا قریبا !
شاخ در آوردم !
توقع داری کار کنه ؟!
پیغامی به این یونیت میرسه ؟
شیئی داری که پیغام های Broadcast شده در سیستم عامل رو Handle کنه ؟
مگه کلاس ها هندل دارن تا سیستم عامل هندلشون رو بگیره و با SendMessage یا PostMessage پیغام WM_DeviceChange یا ... رو بهشون بفرسته ؟!

[Mask]

به قول علی آقا ؛ عجیبا قریبا !
شاخ در آوردم !
توقع داری کار کنه ؟!
پیغامی به این یونیت میرسه ؟
شیئی داری که پیغام های Broadcast شده در سیستم عامل رو Handle کنه ؟
مگه کلاس ها هندل دارن تا سیستم عامل هندلشون رو بگیره و با SendMessage یا PostMessage پیغام WM_DeviceChange یا ... رو بهشون بفرسته ؟!

ممنون میشم بیشتر راهنماییم کنی.

[Felony]

مبنای کار سیستم عامل ویندوز پیغام ها و رد و بدل کردن اونها هست ؛ پیغام ها به وسیله 2 تابع SendMessage و PostMessage در سیستم عامل ویندوز بین برنامه ها و سیستم عامل رد و بدل میشن و اگر قرار باشه یک پیغام به همه پنجره ها برسه Broadcast میشه که در پشت صحنه یک Callback Function لیست هندل ها معتبر رو میگیره و و پیغام رو تک تک بهشون ارسال میکنه ، مثل پیغم WM_DeviceChange یا FontChange ؛ این دو تابع ( SendMessage و PostMessage ) برای ارسال پیغام به مقصد مورد نظر از هندل مقصد استفاده میکنن ، پس اگر مقصد هندلی نداشته باشه نمیشه بهش پیغامی ارسال کرد و اون شئ مقصد هم وقتی هندل نداره 100% Message Handler ی برای پردازش پیغام ها نخواهد داشت چون قرار نیست پیغامی بهش برسه که بخواد پردازشش کنه ؛ این قسمت دقیقا جایی هست که کلا شما اشتباه کردید !

اون کد رو وقتی داخل یونیت فرم برنامتون قرار میدید درست کار میکنه چون WNDProc رو در قسمت Private کلاس TFrom مربوط به فرم برناتون Override کردید ؛ فرم برنامتون از کلاس TFrom هست ، پس هندل داره و براش Message Handler نوشته شده و پیغام های Broadcast شده توسط ویندوز رو دریافت و پردازش میکنه ، پس به WM_DeviceChange که Broadcast میشه عکس العمل نشون میده و شما با Override کردنش گفتید اگر این پیغام رو دریافت کردی روال WMDeviceChange رو اجرا کن ؛ حالا تو اون یونیت جدا کدوم شئ هست که هندل داشته باشه و براش Message Handler نوشته شده باشه که WM_DeviceCHange رو دریافت و پردازش کنه ؟!

باید تو یونیت جدا یک کلاس از کلاس TFrom مشتق کنید تا خصیصه های TFrom رو به ارث ببرید ( نیاز اصلی در اینجا Handle و Message Handler که WNDProc باشه ) و بعد WndProc رو براش Override کنید و خلاص :

unit Unit2;

interface

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

procedure StartMonitorUsb;

type
TMyUsb = class(TForm)
Private
constructor Create(AOwner: TComponent); Override;
procedure WndProc(var Message: TMessage); Override;
procedure DeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
end;

type
TUSBThread = class(TThread)
protected
procedure Execute; override;
end;

var
StatusUSB: Boolean = false;
USBHandle: Cardinal;
USBDrive: string;

const
DBT_DEVICEARRIVAL = $00008000;
DBT_DEVICEREMOVECOMPLETE = $00008004;
DBT_DEVTYP_VOLUME = $00000002;

// Device structs
type
_DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;

DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;
TDevBroadcastHeader = DEV_BROADCAST_HDR;
PDevBroadcastHeader = ^TDevBroadcastHeader;

type
_DEV_BROADCAST_VOLUME = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: WORD;
end;

DEV_BROADCAST_VOLUME = _DEV_BROADCAST_VOLUME;
TDevBroadcastVolume = DEV_BROADCAST_VOLUME;
PDevBroadcastVolume = ^TDevBroadcastVolume;

implementation

procedure StartMonitorUsb;
var
MyUsb: TMyUsb;
begin
MyUsb := TMyUsb.Create(Application);
try
finally
// MyUsb.Free;
end;
end;

constructor TMyUsb.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Name := 'Handle_WMDeviceChange';
Visible := True;
Hide;
end;

procedure TMyUsb.DeviceChange(var Msg: TMessage);
var
lpdbhHeader: PDevBroadcastHeader;
lpdbvData: PDevBroadcastVolume;
dwIndex: Integer;
lpszDrive: String;
PUSBThread: TUSBThread;
begin
inherited;
lpdbhHeader := PDevBroadcastHeader(Msg.lParam);

case Msg.WParam of
DBT_DEVICEARRIVAL: { a USB drive was connected }
begin
if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
lpdbvData := PDevBroadcastVolume(Msg.lParam);
for dwIndex := 0 to 25 do
begin
if ((lpdbvData^.dbcv_unitmask shr dwIndex) = 1) then
begin
lpszDrive := lpszDrive + Chr(65 + dwIndex) + ':';
break;
end;
end;
USBDrive := lpszDrive;
PUSBThread := TUSBThread.Create(True);
PUSBThread.FreeOnTerminate := True;
PUSBThread.Start;
end;
end;
end;
end;

procedure TMyUsb.WndProc(var Message: TMessage);
begin
if (Message.Msg = WM_DEVICECHANGE) then
DeviceChange(Message);
inherited;
end;

{ TUSBThread }

procedure TUSBThread.Execute;
begin
ShowMessage('');
end;

end.

اگر دقت کنید میبینید که Constructor فرم رو هم Override کردم و توش متد CreateNew رو صدا زدم ؛ اگر این کار رو نکنید با پیغام خطا Resource not found رو به رو میشید چون برای ساخت فرم نیاز به فایل dfm مربوط به اون فرم هست ولی فرمی که ما میسازیم فایل dfm نداره و توسط رهنمود کامپایلر {$R *.dfm} فایل dfm ی بهش معرفی نشده .

و اگر احتمالا خواستید بپرسید برای چی Visible رو True کردید و بعد مخفیش کردید ... ؛ مدلشه ، اگر این کار رو نکنی Message Handler پیغام ها رو هندل نمیکنه . ( حدود 10 دقیقه این تیکه الافم کرده بود تا با تست کشف شد ) !

کدهایی که در جاهای مختلف میبینید رو خوب تحلیل و بررسی کنید و کارکرد تک تک خط هاش رو درک کنید ؛ این مشکلات نتیجه کپی و پیست کردن کدها از جاهای مختلف بدون درک نحوه کارکرد اونهاست !

موفق باشید .

[Mask]

ممنون. از وقتی که گزاشتید.
چنتا سوال برام پیش اومده . اگه ممکنه مثل همیشه محبت کنید و جواب بدید.
اول اینکه : یعنی هیچ راهی به غیر از ساخت فرم وجود نداره .؟ مشکل این متد اینه که اول کار یه فرم ساخته میشه و نمایش پیدا میکنه و یهو مخفی میشه.
منظورم اینه که ، راهی نیست که ایونتی طراحی بشه که کار هندل کردن رو به جز فرم داشته باشه؟
مورد بعدی اینکه وقتی یه فلش به سیستم وصل میشه دوتا ترد ساخته میشه و 2 تا مسیج نمایش داده میشه. علت چیه؟
ممنون از پاسختون.

[Felony]

اول اینکه : یعنی هیچ راهی به غیر از ساخت فرم وجود نداره .؟ مشکل این متد اینه که اول کار یه فرم ساخته میشه و نمایش پیدا میکنه و یهو مخفی میشه.
یهو مخفی میشه ؟ یعنی شما این پروسه رو مشاهده میکنید ؟!

اگر میخوای غیر از این باشه میتونی از سورس کامپوننت USB Detector که نوشتم کمک بگیری یا خودت یک شئ طراحی کنی که Handle داشته باشه ( پس باید پنجره باشه ) بعد خودت Message Handler رو برایش پیاده کنی و مدیریت پیغام های دریافتی رو برعهده بگیری ، پس در آخر همون TFrom دلفی میشه که پیاده سازیش خیلی بهینه تر و بهتر از چیزی هست که میخوای طراحی کنی .


مورد بعدی اینکه وقتی یه فلش به سیستم وصل میشه دوتا ترد ساخته میشه و 2 تا مسیج نمایش داده میشه. علت چیه؟
میتونی یک متغییر Boolean در نظر بگیری و بار اول که پیغام رسید اون رو True کنی و کار مورد نظرت رو انجام بدی و بار دوم که پیغام رسید فقط متغییرت رو False کنی تا در اتصال بعدی مشکلی پیش نیاد .

[Mask]

یهو مخفی میشه ؟ یعنی شما این پروسه رو مشاهده میکنید ؟!
دقیقا . حتی این نمایش صفحه اونقدر ملموسه که تا حدودی میشه کپشن اون فرم رو خوند.(البته کپنش اسم همون فرمه).

چون برنامه 2 بار این پیغام رو دریافت میکنه ( چراش بر میگرده به سیستم عامل نه برنامه شما یا دلفی ) ؛ میتونی یک متغییر Boolean در نظر بگیری و بار اول که پیغام رسید اون رو True کنی و کار مورد نظرت رو انجام بدی و بار دوم که پیغام رسید فقط متغییرت رو False کنی تا در اتصال بعدی مشکلی پیش نیاد .
اگه واقعا 2 بار این پیغام رو برنامه دریافت میکنه ، چرا پس وقتی این کد رو در فرم اصلی میزاریم ، بدون متغیر بولینی ، فقط یه بار پیغام نمایش داده میشه؟
و یه سوال دیگه اینکه : چون ما نیاز به حضور تمام وقت این کلاس و فرم داریم ، و مجبوریم free نکنیم ، کی باید این کار انجام بشه؟

[Felony]

دقیقا . حتی این نمایش صفحه اونقدر ملموسه که تا حدودی میشه کپشن اون فرم رو خوند.(البته کپنش اسم همون فرمه).
میتونی از سورس کامپوننتی که من نوشتم کمک بگیری ( USB Detector ) یا اینکه قبل از Visible شدن فرم مختصات اون رو به خارج از صفحه نمایش منتقل کنی .


اگه واقعا 2 بار این پیغام رو برنامه دریافت میکنه ، چرا پس وقتی این کد رو در فرم اصلی میزاریم ، بدون متغیر بولینی ، فقط یه بار پیغام نمایش داده میشه؟
کد مربوط به WndProc رو اینطور بنویس :

if (Message.Msg = WM_DEVICECHANGE) then
DeviceChange(Message)
else
inherited;


و یه سوال دیگه اینکه : چون ما نیاز به حضور تمام وقت این کلاس و فرم داریم ، و مجبوریم free نکنیم ، کی باید این کار انجام بشه؟
نیازی به آزاد سازیش نیست ، چون مالکش در کدی که نوشتنم Application در نظر گرفته شده و خود برنامه موقع بسته شدن آزادش میکنه .

در ضمن اگر قراره با باز شدن برنامه شروع به کار کنه بهتره اینطور نوشته بشه ، دیگه نیازی به روال StartMonitorUSB نیست :

unit Unit2;

interface

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

type
TMyUsb = class(TForm)
Private
constructor Create(AOwner: TComponent); Override;
procedure WndProc(var Message: TMessage); Override;
procedure DeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
end;

type
TUSBThread = class(TThread)
protected
procedure Execute; override;
end;

var
MyUSB: TMyUsb;
StatusUSB: Boolean = false;
USBHandle: Cardinal;
USBDrive: string;

const
DBT_DEVICEARRIVAL = $00008000;
DBT_DEVICEREMOVECOMPLETE = $00008004;
DBT_DEVTYP_VOLUME = $00000002;

// Device structs
type
_DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;

DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;
TDevBroadcastHeader = DEV_BROADCAST_HDR;
PDevBroadcastHeader = ^TDevBroadcastHeader;

type
_DEV_BROADCAST_VOLUME = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: WORD;
end;

DEV_BROADCAST_VOLUME = _DEV_BROADCAST_VOLUME;
TDevBroadcastVolume = DEV_BROADCAST_VOLUME;
PDevBroadcastVolume = ^TDevBroadcastVolume;

implementation

constructor TMyUsb.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Name := 'Handle_WMDeviceChange';
Visible := True;
Hide;
end;

procedure TMyUsb.DeviceChange(var Msg: TMessage);
var
lpdbhHeader: PDevBroadcastHeader;
lpdbvData: PDevBroadcastVolume;
dwIndex: Integer;
lpszDrive: String;
PUSBThread: TUSBThread;
begin
inherited;
lpdbhHeader := PDevBroadcastHeader(Msg.lParam);
case Msg.WParam of
DBT_DEVICEARRIVAL: { a USB drive was connected }
begin
if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
lpdbvData := PDevBroadcastVolume(Msg.lParam);
for dwIndex := 0 to 25 do
begin
if ((lpdbvData^.dbcv_unitmask shr dwIndex) = 1) then
begin
lpszDrive := lpszDrive + Chr(65 + dwIndex) + ':';
break;
end;
end;
USBDrive := lpszDrive;
PUSBThread := TUSBThread.Create(True);
PUSBThread.FreeOnTerminate := True;
PUSBThread.Start;
end;
end;
end;
end;

procedure TMyUsb.WndProc(var Message: TMessage);
begin
if (Message.Msg = WM_DEVICECHANGE) then
DeviceChange(Message)
else
inherited;
end;

{ TUSBThread }

procedure TUSBThread.Execute;
begin
ShowMessage(USBDrive);
end;

initialization

MyUSB := TMyUsb.Create(Application);

end.

فقط یادت باشه بعد از تست کامل یک یونیت برای اون بلوک initialization یا finalization تعریف کنی ، چون این 2 بلوک در Application Exception Handler در نظر گرفته نمیشن و هر خطایی درش رخ بده برنامه با Runtime Error بسته میشه .

[Mask]

ممنون.
موقعیت فرم رو تغییر دادم ، قبل از نمایش ، اما بازم جلوی چشم ساخته میشد. اومدم مقدار AlphaBlendValue رو صفر کردم. خوب شد ، و فرم مخفی شد.
چنتا سوال کوچولو دیگه :
علت اینکه کد رو به این شکل تغییر دادید ، چیه؟

PUSBThread.Start;
و یه نکته دیگه ، اگه در کد زیر به جای True مقدار false رو قرار بدیم چه اتفاقی میوفته؟

PUSBThread := TUSBThread.Create(True);
و نکته آخر اینکه کد زیر یعنی چی:

if (Message.Msg = WM_DEVICECHANGE) then
DeviceChange(Message)
else
inherited;
آیا برنامه پیغام دیگه ای رو میگرفت ، و به جای WM_DEVICECHANGE به مسیج هندلر ما ، میرسید؟
ممنونم ازت. باشه که جبران کنیم.

[Felony]

علت اینکه کد رو به این شکل تغییر دادید ، چیه؟
متد Resume توسط Embarcadero منسوخ شده و به گفته خودش باید جاش از Start استفاده کرد .


و یه نکته دیگه ، اگه در کد زیر به جای True مقدار false رو قرار بدیم چه اتفاقی میوفته؟
متد Execute ترد در همون زمان صدا زده شدن متد Create اجرا میشه و باقی کد بیفایده هست ؛ وقتی پارامتر True ارجاع داده بشه تا زمان صدا زده شدن Resume یا Start متد Execute ترد اجرا نمیشه .


آیا برنامه پیغام دیگه ای رو میگرفت ، و به جای WM_DEVICECHANGE به مسیج هندلر ما ، میرسید؟
یه همچین چیزایی ؛ اون کد به این معنی هست که اگر WM_DeviceChange دریافت شد روال DeviceChange رو اجرا کن و اگر پیغامی چیزی جز WM_DeviceChange بود Default Handler رو اجرا کن ؛ کد قبلی حالتی مثل اکو به وجود میاره ( هم روال مورد نظر ما رو اجرا میکنه ، هم Default Handler رو ) که به این صورت میشه حلش کرد .