Бывалый
Профиль
Группа: Участник
Сообщений: 180
Регистрация: 16.7.2003
Где: Россия - Уфа
Репутация: нет
Всего: 1
|
| Код | {##########################################################}
{# #}
{# Component: TMJDiskInfo (ver. 1.0.2) #}
{# Copyright: MJ Soft 2002 (Russia) FreeWare #}
{# #}
{# Компонент: TMJDiskInfo (версия 1.0.2) #}
{# Написано: MJ Soft 2002 (Россия, г.Уфа) #}
{# Распространение: Бесплатно #}
{# #}
{# [URL=http://pascal.dax.ru/]http://pascal.dax.ru/[/URL] #}
{# e-mail: [email protected] ([email protected]) #}
{# #}
{##########################################################}
unit MJDiskInfo;
{$WARN SYMBOL_DEPRECATED OFF}
interface
uses
Windows, SysUtils, Classes, Messages, Forms;
const
MJDiskMonStr = 'MJ.DiskMon';
type
TDriveType = (dtUnknown, dtNoRootDir, dtRemovable, dtFixed, dtRemote,
dtCDRom, dtRamDisk, UnknowNewFormat);
TDirMonitorEvent = procedure(Sender: TObject) of object;
type
TDirMonType = (dmtFileName, dmtDirName, dmtAttributes, dmtSize,
dmtLastWrite, dmtSecurity);
TDirMonTypes = set of TDirMonType;
TMJDiskInfo = class(TComponent)
private
FDisk: Char;
FSerial: Cardinal;
FTSerial: String;
FVolume: String;
FMaximumComponentLength: Cardinal;
FFileSystem: String;
FFileSystemFlags: Cardinal;
FDriveType: TDriveType;
FActiveDirMonitor: Boolean;
FHandle: HWND;
FDirMonitorNotifyFilter: Cardinal;
FDirMonitorParamPtr: Pointer;
FDirMonitorMutexHandle: THandle;
FDirMonitorNested: Boolean;
FDirMonitorThreadHandle: THandle;
FDirMonitorThreadID: Cardinal;
FDirMonitorDirectory: String;
FOnDirChange: TNotifyEvent;
FOnDirError: TNotifyEvent;
function GetAboutStr: String;
function GetCopyrightStr: String;
procedure SetDisk(const Value: Char);
procedure SetLabel(const Value: String);
procedure SetActiveDirMonitor(const Value: Boolean);
function GetDirMonitorFilter: TDirMonTypes;
procedure SetDirMonitorFilter(const Value: TDirMonTypes);
procedure SetDirMonitorDirectory(const Value: String);
procedure SetDirMonitorNested(const Value: Boolean);
procedure DoStartMon;
procedure DoStopMon;
protected
procedure Loaded; override;
procedure WndProc(var Message: TMessage); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UpDateInfo;
function TestInsDisk: Boolean;
procedure StartMon;
procedure StopMon;
published
property About: String read GetAboutStr;
property Copyright: String read GetCopyrightStr;
property Disk: Char read FDisk write SetDisk stored False;
property Serial: Cardinal read FSerial;
property SerialText: String read FTSerial;
property VolumeLabel: String read FVolume write SetLabel stored False;
property MaximumComponentLength: Cardinal read FMaximumComponentLength;
property FileSystem: String read FFileSystem;
property FileSystemFlags: Cardinal read FFileSystemFlags;
property DriveType: TDriveType read FDriveType;
property ActiveDirMonitor: Boolean read FActiveDirMonitor write SetActiveDirMonitor;
property DirMonitorFilter: TDirMonTypes read GetDirMonitorFilter write SetDirMonitorFilter;
property DirMonitorDirectory: String read FDirMonitorDirectory write SetDirMonitorDirectory;
property DirMonitorNested: Boolean read FDirMonitorNested write SetDirMonitorNested;
property OnDirChange: TNotifyEvent read FOnDirChange write FOnDirChange;
property OnDirError: TNotifyEvent read FOnDirError write FOnDirError;
end;
procedure Register;
implementation
var
WM_DISKMON: Cardinal;
type
TDirMonParams = record
WindowHandle: HWND;
hMutex: THandle;
Directory: array [0..MAX_PATH] of Char;
NotifyFilter: Cardinal;
Nested: Boolean;
end;
PDirMonParams = ^TDirMonParams;
{ TMJDiskInfo }
constructor TMJDiskInfo.Create(AOwner: TComponent);
begin
inherited;
FDirMonitorNotifyFilter := FILE_NOTIFY_CHANGE_FILE_NAME;
FDirMonitorNested := False;
FDirMonitorMutexHandle := 0;
FActiveDirMonitor := False;
SetDisk(#0);
end;
destructor TMJDiskInfo.Destroy;
begin
if FActiveDirMonitor then
StopMon;
inherited;
end;
function DirMonitorThread(Prm: Pointer): DWORD; stdcall;
var
pParams: PDirMonParams;
hObjects: array[0..1] of THandle;
Status: Integer;
const
B: array[Boolean] of Integer = (0, 1);
begin
if Prm=nil then
ExitThread(1);
pParams := PDirMonParams(Prm);
hObjects[1] := pParams^.hMutex;
hObjects[0] := FindFirstChangeNotification(pParams^.Directory,
LongBool(B[pParams^.Nested]), pParams^.NotifyFilter);
if hObjects[0]=INVALID_HANDLE_VALUE then
begin
PostMessage(pParams^.WindowHandle, WM_DISKMON, -1, -1);
ExitThread(GetLastError);
end;
while True do
begin
Status := WaitForMultipleObjects(2, @hObjects, FALSE, INFINITE);
case Status of
WAIT_OBJECT_0: begin
PostMessage(pParams^.WindowHandle, WM_DISKMON, 0, 0);
if not FindNextChangeNotification(hObjects[0]) then
begin
FindCloseChangeNotification(hObjects[0]);
PostMessage(pParams^.WindowHandle, WM_DISKMON, -1, -1);
ExitThread(GetLastError);
end;
end;
WAIT_OBJECT_0+1:
begin
FindCloseChangeNotification(hObjects[0]);
ReleaseMutex(pParams^.hMutex);
PostMessage(pParams^.WindowHandle, WM_DISKMON, 1, 1);
ExitThread(0);
end;
end;
end;
end;
procedure TMJDiskInfo.DoStartMon;
var
P: PDirMonParams;
begin
if (csDesigning in ComponentState) or (csLoading in ComponentState) then Exit;
FHandle := AllocateHWnd(WndProc);
FDirMonitorMutexHandle := CreateMutex(nil, False, nil);
if FDirMonitorMutexHandle=0 then
raise Exception.Create('CreateMutex failed');
WaitForSingleObject(FDirMonitorMutexHandle, INFINITE);
GetMem(P, SizeOf(P^));
FDirMonitorParamPtr := P;
P^.WindowHandle := FHandle;
P^.hMutex := FDirMonitorMutexHandle;
P^.NotifyFilter := FDirMonitorNotifyFilter;
P^.Nested := FDirMonitorNested;
StrCopy(P^.Directory, PChar(FDirMonitorDirectory));
FDirMonitorThreadHandle := CreateThread(nil, 0, @DirMonitorThread, P, 0, FDirMonitorThreadId);
if FDirMonitorThreadHandle=0 then
begin
ReleaseMutex(FDirMonitorMutexHandle);
DeallocateHWnd(FHandle);
raise Exception.Create('CreateThread failed');
end;
end;
procedure TMJDiskInfo.DoStopMon;
begin
if (csDesigning in ComponentState) or (csLoading in ComponentState) then Exit;
ReleaseMutex(FDirMonitorMutexHandle);
WaitForSingleObject(FDirMonitorThreadHandle, INFINITE);
CloseHandle(FDirMonitorMutexHandle);
FreeMem(FDirMonitorParamPtr);
DeallocateHWnd(FHandle);
end;
function TMJDiskInfo.GetAboutStr: String;
begin
Result := 'Component TMJDiskInfo';
end;
function TMJDiskInfo.GetCopyrightStr: String;
begin
Result := '2002 MJ Soft';
end;
function TMJDiskInfo.GetDirMonitorFilter: TDirMonTypes;
begin
Result := [];
if (FDirMonitorNotifyFilter and FILE_NOTIFY_CHANGE_FILE_NAME)<>0 then
Result := Result+[dmtFileName];
if (FDirMonitorNotifyFilter and FILE_NOTIFY_CHANGE_DIR_NAME)<>0 then
Result := Result+[dmtDirName];
if (FDirMonitorNotifyFilter and FILE_NOTIFY_CHANGE_ATTRIBUTES)<>0 then
Result := Result+[dmtAttributes];
if (FDirMonitorNotifyFilter and FILE_NOTIFY_CHANGE_SIZE)<>0 then
Result := Result+[dmtSize];
if (FDirMonitorNotifyFilter and FILE_NOTIFY_CHANGE_LAST_WRITE)<>0 then
Result := Result+[dmtLastWrite];
if (FDirMonitorNotifyFilter and FILE_NOTIFY_CHANGE_SECURITY)<>0 then
Result := Result+[dmtSecurity];
end;
procedure TMJDiskInfo.Loaded;
begin
inherited;
if FActiveDirMonitor then
StartMon;
end;
procedure TMJDiskInfo.SetActiveDirMonitor(const Value: Boolean);
begin
if FActiveDirMonitor=Value then
Exit;
if Value then
StartMon
else
StopMon;
end;
procedure TMJDiskInfo.SetDirMonitorDirectory(const Value: String);
var
T: Boolean;
begin
if FDirMonitorDirectory=Value then
Exit;
T := FActiveDirMonitor;
if T then
StopMon;
FDirMonitorDirectory := Value;
if T then
StartMon;
end;
procedure TMJDiskInfo.SetDirMonitorFilter(const Value: TDirMonTypes);
begin
FDirMonitorNotifyFilter := 0;
if dmtFileName in Value then
FDirMonitorNotifyFilter := (FDirMonitorNotifyFilter or FILE_NOTIFY_CHANGE_FILE_NAME);
if dmtDirName in Value then
FDirMonitorNotifyFilter := (FDirMonitorNotifyFilter or FILE_NOTIFY_CHANGE_DIR_NAME);
if dmtAttributes in Value then
FDirMonitorNotifyFilter := (FDirMonitorNotifyFilter or FILE_NOTIFY_CHANGE_ATTRIBUTES);
if dmtSize in Value then
FDirMonitorNotifyFilter := (FDirMonitorNotifyFilter or FILE_NOTIFY_CHANGE_SIZE);
if dmtLastWrite in Value then
FDirMonitorNotifyFilter := (FDirMonitorNotifyFilter or FILE_NOTIFY_CHANGE_LAST_WRITE);
if dmtSecurity in Value then
FDirMonitorNotifyFilter := (FDirMonitorNotifyFilter or FILE_NOTIFY_CHANGE_SECURITY);
end;
procedure TMJDiskInfo.SetDirMonitorNested(const Value: Boolean);
var
T: Boolean;
begin
if FDirMonitorNested=Value then
Exit;
T := FActiveDirMonitor;
if T then
StopMon;
FDirMonitorNested := Value;
if T then
StartMon;
end;
procedure TMJDiskInfo.SetDisk(const Value: Char);
var
C: Char;
Buffer: array[0..255] of Char;
begin
C := UpCase(Value);
if (C<'A') or (C>'Z') then
begin
GetWindowsDirectory(@Buffer, SizeOf(Buffer));
C := Buffer[0];
end;
FDisk := C;
UpDateInfo;
end;
procedure TMJDiskInfo.SetLabel(const Value: String);
begin
SetVolumeLabel(PChar(FDisk+':\'), PChar(Value));
UpDateInfo;
end;
procedure TMJDiskInfo.StartMon;
begin
if FActiveDirMonitor or (FDirMonitorNotifyFilter=0) or
((FDirMonitorDirectory='') and not (csLoading in ComponentState)) then Exit;
FActiveDirMonitor := True;
DoStartMon;
end;
procedure TMJDiskInfo.StopMon;
begin
if not FActiveDirMonitor then Exit;
FActiveDirMonitor := False;
DoStopMon;
end;
function TMJDiskInfo.TestInsDisk: Boolean;
var
EMode: Word;
begin
Result := False;
EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
if DiskSize(Byte(FDisk)-$40)<>-1 then Result := True;
finally
SetErrorMode(EMode);
end;
end;
procedure TMJDiskInfo.UpDateInfo;
var
SerialNum: PDWord;
MaximumComponentLength_, FileSystemFlags_: DWord;
Buffer1, Buffer2: array[0..255] of Char;
begin
New(SerialNum);
if GetVolumeInformation(PChar(FDisk+':\'), Buffer1, SizeOf(Buffer1), SerialNum,
MaximumComponentLength_, FileSystemFlags_, Buffer2, SizeOf(Buffer2)) then
begin
FSerial := SerialNum^;
SetString(FVolume, Buffer1, StrLen(Buffer1));
FMaximumComponentLength := MaximumComponentLength_;
FFileSystemFlags := FileSystemFlags_;
SetString(FFileSystem, Buffer2, StrLen(Buffer2));
end
else begin
FSerial := 0;
FVolume := '';
FMaximumComponentLength := 0;
FFileSystemFlags := 0;
FFileSystem := '';
end;
Dispose(SerialNum);
FDriveType := TDriveType(GetDriveType(PChar(FDisk+':\')));
FTSerial := IntToHex(FSerial shr 16, 4)+'-'+IntToHex(FSerial and $FFFF, 4);
end;
procedure TMJDiskInfo.WndProc(var Message: TMessage);
begin
if Message.Msg=WM_DISKMON then
begin
if Message.LParam=0 then
if Assigned(FOnDirChange) then
try
FOnDirChange(Self);
except
end
else begin
DoStopMon;
FActiveDirMonitor := False;
if (Message.LParam<0) and Assigned(FOnDirError) then
try
FOnDirError(Self);
except
end;
end;
end
else if Message.Msg = WM_QUERYENDSESSION then
Message.Result := 1;
end;
procedure Register;
begin
RegisterComponents('MJ', [TMJDiskInfo]);
end;
initialization
WM_DISKMON := RegisterWindowMessage(MJDiskMonStr);
finalization
end. |
Это сообщение отредактировал(а) pascal - 9.8.2003, 16:54
|
<<Серийный номер винта?>> 
Дата 8.8.2003, 06:06 (
Загрузка ...
