procedure WriteDataInMMF(s:string);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

procedure N5Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure ToolButton3Click(Sender: TObject);

procedure ToolButton1Click(Sender: TObject);

procedure N8Click(Sender: TObject);

procedure N2Click(Sender: TObject);

private

procedure AppHint(Sender: TObject);

public

HMutex:THandle;

ThreadRec:TThreadReceiver;

HEvent:THandle;

HFileSender:Thandle;

NicName:string;

end;

var

Form1: TForm1;

TxtFile:TextFile;// пременная файла

St:PansiChar;

lincInt:Boolean;

TxtContaningStr:String;

userName:string;

implementation

{$R *.dfm}

//процедура для показа кртких справок

procedure TForm1.AppHint(Sender: TObject);

begin

StatusBar1.SimpleText:=Application.Hint; //для отображения ииформации в панели соостояния

end;

//закрытие всех хендлов в этой копии программы

procedure TForm1.CloseHandles();

begin

CloseHandle(HFileSender);

CloseHandle(HMutex);

CloseHandle(HEvent);

end;

// создание всех необходимых объектов

procedure TForm1.CreateHandles;

begin

// проекция файла

HFileSender:=CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SHARED_MEMORY_SIZE,MMFName);

lincInt:=(GetLastError() <> ERROR_ALREADY_EXISTS);

if HFileSender = 0 then

begin

st:='не удалось создать проекцию файла';

Application.MessageBox(st,'Сообщение...',MB_OK);

exit;

end;

// мьютекс

HMutex:=CreateMutex(nil,false,MutxName);

if HMutex = 0 then

begin

CloseHandle(HFileSender);

st:='не удалось синхронизировать приложение';

Application.MessageBox(st,'Сообщение...',MB_OK);

exit;

end;

// событие

HEvent:=CreateEvent(nil,true,false,EvntName);

if HEvent = 0 then

begin

CloseHandle(HFileSender);

CloseHandle(HMutex);

st:='не удалось осуществить обмен сообщениями';

Application.MessageBox(st,'Сообщение...',MB_OK);

exit;

end;

end;

// отсоединиться

procedure TForm1.Button1Click(Sender: TObject);

begin

ThreadRec.Terminate;

WriteDataInMMF('Пользователь '+NicName+' отключился');

ThreadRec.WaitFor;

ThreadRec.Free;// правильно уничтожаем поток

CloseHandles();

button2.Visible:=true;

button1.Visible:=false;

bitbtn2.Visible:=false;

end;

// загрузить историю переписки

procedure TForm1.N4Click(Sender: TObject);

begin

if OpenDialog1.Execute then

begin

AssignFile(TxtFile,OpenDialog1.FileName);

Reset(TxtFile);

Memo1.Text:=Memo1.Text +'{-----------Загруженная переписка ниже-------------}' + #13#10;

while not eof(TxtFile) do

begin

readln(TxtFile,TxtContaningStr);

Memo1.Text:=Memo1.Text + TxtContaningStr + #13#10;

end;

Memo1.Text:=Memo1.Text +'{-----------Загруженная переписка выше -------------}' + #13#10;

CloseFile(TxtFile);

end;

end;

//процедура записи данных в MMF

procedure TForm1.WriteDataInMMF(s:string);

var

PBaseAdress:Pointer;

begin

WaitForSingleObject(HMutex, INFINITE);

PBaseAdress:=MapViewOfFile(HFileSender,FILE_MAP_WRITE,0,0,Length(s)+4);

if(PBaseAdress = nil) then

begin

CloseHandle(HFileSender);

st:='не удалось передать данные';

Application.MessageBox(st,'Сообщение...',MB_OK);

exit;

end;

begin

integer(PBaseAdress^):=length(s);

CopyMemory(Pointer(Integer(PBaseAdress)+4),PChar(s),length(s));

UnmapViewOfFile(PBaseAdress);

SetEvent(HEvent);

ReleaseMutex(HMutex);

end;

end;

// процедура записи данных в PBaseAdress

procedure TForm1.BitBtn2Click(Sender: TObject);

begin

if Edit1.Text <> '' then

begin

WriteDataInMMF(Nicname+' написал:'+#13#10+string(Edit1.Text));

Edit1.Text:='';

end

else

exit;

end;

// Закрытия формы

procedure TForm1.BitBtn3Click(Sender: TObject);

begin

close;

end;

//создаём хендлы и потоки

procedure TForm1.FormCreate(Sender: TObject);

begin

Memo1.Clear;

// создание потока принимающего данные из файла

ThreadRec:=TThreadReceiver.Create(false);

ThreadRec.Priority:=tpLowest;

CreateHandles();// создаем хендлы

end;

// соединение

procedure TForm1.Button2Click(Sender: TObject);

begin

CreateHandles();

ThreadRec:=TThreadReceiver.Create(false);

button2.Visible:=false;

button1.Visible:=true;

bitbtn2.Visible:=true;

WriteDataInMMF(NicName+' Cоединился!');

end;

// Запрос подтверждения при закрытии формы

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

case messageBox(Handle,'Действительно выйти?','Внимание!', MB_YESNO) of

IDYES:

begin

if Button1.Visible = true then

begin

ThreadRec.Terminate;

WriteDataInMMF('Пользователь '+NicName+' отключился');

ThreadRec.WaitFor;

ThreadRec.Free;

CanClose:=true;

end

else

CanClose:=true;

end;

IDNO: CanClose:=false;

end;

end;

//Сохранить историю переписки

procedure TForm1.N5Click(Sender: TObject);

begin

If SaveDialog1.Execute then

begin

AssignFile(TxtFile,SaveDialog1.FileName);

rewrite(TxtFile);

TxtContaningStr:= Memo1.Text;

Write(TxtFile,TxtContaningStr);

CloseFile(TxtFile);

St:='Файл сохранён';

Application.MessageBox(St,'Сообщение...',MB_OK);

exit;

end

else

begin

St:='файл не сохранён';

Application.MessageBox(St,'Сообщение...',MB_OK);

end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

if Form1.Visible = true then

begin

Application.OnHint:=AppHint;

Timer1.Enabled:=false;

Timer1.Destroy;

end;

end;

procedure TForm1.ToolButton3Click(Sender: TObject);

begin

Application.CreateForm(TForm3, Form3);

Application.ShowMainForm:=false;

Form3.Visible:=true;

end;

procedure TForm1.ToolButton1Click(Sender: TObject);

begin

//вызов справки (основная форма программы)

Application.HelpContext(2);

end;

procedure TForm1.N8Click(Sender: TObject);

begin

Application.HelpCommand(HELP_FINDER,0);

end;

procedure TForm1.N2Click(Sender: TObject);

begin

ShowMessage('Программу подготовил студент группы 742:'+#13#10+'Шипилов Д.А.');

end;

end.

3) Текст модуля Unit2 (Модуль формы «Авторизация»):

unit Unit2;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls,Unit1, ComCtrls, Buttons;

type

TForm2 = class(TForm)

Button2: TButton;

Edit1: TEdit;

Label1: TLabel;

BitBtn1: TBitBtn;

procedure Button2Click(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

formClose:boolean=false;

implementation

{$R *.dfm}

// закрытие формы

procedure TForm2.Button2Click(Sender: TObject);

begin

close;

end;

// запрос подтверждения при завершении программы из дочерней формы

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

if formClose = true then

begin

CanClose:=true;

end

else

begin

case messageBox(Handle,'Действительно выйти?','Внимание!', MB_YESNO) of

IDYES:

begin

Application.Terminate;

end;

IDNO: CanClose:=false;

end;

end;

end;

procedure TForm2.BitBtn1Click(Sender: TObject);

var

St:PansiChar;

begin

if Edit1.Text <> '' then

begin

formClose:=true;

Form1.Memo1.Clear;

Form1.NicName:=Edit1.Text;

Form1.WriteDataInMMF('Пользователь '+Form1.NicName+' подключился');

Application.ShowMainForm:=true;

Form1.Visible:=true;

Form2.Close;

end

else

begin

st:='Пожалуйста введите псевдоним для авторизации';

Application.MessageBox(st,'Сообщение...',MB_OK);

exit;

end;

end;

end.

4) Модуль Unit 3 (Модуль формы, осуществляющей работу с носителями информации в системе):

unit Unit3;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, FileCtrl, ExtCtrls, Grids, ValEdit,HDDInfo, Buttons,

ComCtrls;

const

IOCTL_DISK_GET_DRIVE_GEOMETRY = $70000;

type

// версия ОС

TWinVersion = (wvUnknown,wv95,wv98,wvME,wvNT3,wvNT4,wvW2K,wvXP,wv2003,wvVista,wv7);

//геометрия

TDiscGeometry = packed record

Cylinders: Int64; // колличество цилиндров

MediaType: DWORD; // тип носителя

TracksPerCylinder: DWORD; // дорожек на цилиндре

SectorsPerTrack: DWORD; // секторов на дорожке

BytesPerSector: DWORD; // байт в секторе

end;

//TForm

TForm3 = class(TForm)

Button1: TButton;

DriveComboBox1: TDriveComboBox;

Panel1: TPanel;

Button2: TButton;

Grid1: TStringGrid;

Button3: TButton;

GroupBox1: TGroupBox;

bpbList: TValueListEditor;

Label1: TLabel;

GroupBox2: TGroupBox;

Disks: TLabel;

BitBtn1: TBitBtn;

GroupBox3: TGroupBox;

Memo1: TMemo;

Grid2: TStringGrid;

Label2: TLabel;

Memo2: TMemo;

Label3: TLabel;

procedure Button1Click(Sender: TObject);

procedure DiscGeometryShow;

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure FormActivate(Sender: TObject); // Result = LoDWORD

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

hDrive,hMBRDrive: THandle;

DiscGeometry:TDiscGeometry;

typeOfDisc:string;

implementation

{$R *.dfm}

// определение версии ОС

function DetectWinVersion : TWinVersion;

var

OSVersionInfo : TOSVersionInfo;

begin

Result := wvUnknown; // Неизвестная версия ОС

OSVersionInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfo);

if GetVersionEx(OSVersionInfo)

then

begin

case OSVersionInfo.DwMajorVersion of

3: Result := wvNT3; // Windows NT 3

4: case OSVersionInfo.DwMinorVersion of

0: if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT

then Result := wvNT4 // Windows NT 4

else Result := wv95; // Windows 95

10: Result := wv98; // Windows 98

90: Result := wvME; // Windows ME

end;

5: case OSVersionInfo.DwMinorVersion of

0: Result := wvW2K; // Windows 2000

1: Result := wvXP; // Windows XP

2: Result := wv2003; // Windows 2003

end;

6: case OSVersionInfo.DwMinorVersion of

0: Result := wvVista; // Windows Vista

1: Result := wv7; // Windows 7

end;

end;

end;

end;

// для вывода версии

function DetectWinVersionStr : string;

const

VersStr : array[TWinVersion] of string = (

'Unknown',

'Windows 95',

'Windows 98',

'Windows ME',

'Windows NT 3',

'Windows NT 4',

'Windows 2000',

'Windows XP',

'Windows 2003',

'Windows Vista',

'Windows Seven');

begin

Result := VersStr[DetectWinVersion];

end;

// для перемещения по диску

function __Mul(a,b: DWORD; var HiDWORD: DWORD):DWORD;

asm

mul edx

mov [ecx],edx

end;

// Чтение сектора жесткго диска(Вызыв когда работа с диском начата)

function ReadSectors(hDrive:Thandle; StartingSector, SectorCount: DWORD;

Buffer: Pointer; BytesPerSector: DWORD): DWORD;

var

br,TmpLo,TmpHi: DWORD;

begin

Result := 0;

TmpLo := __Mul(StartingSector,BytesPerSector,TmpHi);

if SetFilePointer(hDrive,TmpLo,@TmpHi,FILE_BEGIN) = TmpLo then

begin

SectorCount := SectorCount*BytesPerSector;

if ReadFile(hDrive,Buffer^,SectorCount,br,nil) then Result := br;

end;

end;

// вывод геометрии

procedure TForm3.DiscGeometryShow;

begin

Memo1.Clear;

Memo1.Text:='Вы просматриваете логический диск: '+DriveComboBox1.Drive+#13#10;

Memo1.Text:= memo1.Text + 'Количество цилиндров: '+inttoStr(DiscGeometry.Cylinders)+#13#10;

case DiscGeometry.MediaType of

12:typeOfDisc:=' жёсткий диск';

11:typeOfDisc:=' съёмный носитель';

end;

Memo1.Text:= memo1.Text + 'Тип носителя: '+typeOfDisc+#13#10;

Memo1.Text:= memo1.Text + 'Дорожек на цилиндре: '+intToStr(DiscGeometry.TracksPerCylinder)+#13#10;

Memo1.Text:= memo1.Text + 'Секторов на дорожке: '+intToStr(DiscGeometry.SectorsPerTrack)+#13#10;

Memo1.Text:= memo1.Text + 'Байт в секторе: '+intToStr(DiscGeometry.BytesPerSector)+#13#10;

end;

//создаем файл диска/выводим геомертию

//начинаем работу с жёстким диском

procedure TForm3.Button1Click(Sender: TObject);

var

discNameBPB,discNameMBR:string;

junk:Cardinal;

result:boolean;

begin

if hDrive <> 0 then CloseHandle(hDrive);

if hMBRDrive <> 0 then CloseHandle(hMBRDrive);

discNameBPB:='\\.\'+DriveComboBox1.Drive+':';

discNameMBR:='\\.\PHYSICALDRIVE'+intToStr(0);

hMBRDrive:= CreateFile(PChar(discNameMBR),GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);

hDrive:= CreateFile(PChar(discNameBPB),GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);

if (hDrive <> INVALID_HANDLE_VALUE) and (hMBRDrive <> INVALID_HANDLE_VALUE) then

begin

Result := DeviceIoControl(hDrive,IOCTL_DISK_GET_DRIVE_GEOMETRY,nil,0,

@DiscGeometry,SizeOf(TDiscGeometry),junk,nil) and (junk = SizeOf(TDiscGeometry));

DiscGeometryShow();

end

else

begin

ShowMessage('Не возможно создать дескрипторы носителя');

exit;

end;

end;

// Чтение и рашифровка BPB

procedure TForm3.Button2Click(Sender: TObject);

var

i,j,k:integer;

read:Cardinal;

s:string;

buffer: array[1..131072] of byte;

begin

if ReadSectors(hDrive,0,1,@buffer,DiscGeometry.BytesPerSector) = DiscGeometry.BytesPerSector then

begin

for i:= 1 to 16 do

Grid1.Cells[i,0]:=intToHex((i-1),1);

i:=1; j:=1; k:=1;

while k<=DiscGeometry.BytesPerSector do

begin

if i=1 then Grid1.Cells[0,j]:=IntToHex(((j-1)*16+(i-1)),3);

Grid1.Cells[i,j]:=IntToHex(Buffer[k],2);

inc(k);

inc(i);

if i>16 then

begin

i:=1;

j:=j+1;

Grid1.RowCount:= Grid1.RowCount+1;

end;

end;

// расшифровка данных BPB

for i:= 1 to 3 do

s:=s+ intToHex(buffer[i],2);

bpbList.Cells[1,1]:= s + 'h';

s:='';

// чтение имени ОС

for i:= 4 to 4 + 7 do

s:=s+ chr(buffer[i]);

bpbList.Cells[1,2]:= s;

s:='';

//--------------------------

bpbList.Cells[1,3]:=IntToStr(buffer[$C+1] shl 8 + buffer[$C]);

bpbList.Cells[1,4]:=IntToStr(buffer[$C + 2]);

bpbList.Cells[1,5]:=intToStr(buffer[$C + 4] shl 8 + buffer[$C+3]);

bpbList.Cells[1,6]:=intToStr(buffer[$C+5]);

bpbList.Cells[1,7]:=IntToStr(buffer[$F + 4] shl 8 + buffer[$F + 3]);

bpbList.Cells[1,8]:=intToStr(buffer[$F+6] shl 8 + buffer[$F + 5]);

bpbList.Cells[1,9]:=intToHex(buffer [22],2);

if bpbList.Cells[1,9] = 'F8' then bpbList.Cells[1,9]:='Системный носитель инФормации'

else if bpbList.Cells[1,9] = 'FDh' then bpbList.Cells[1,9]:=' накопитель - 2 стороны, 9 секторов'

else if bpbList.Cells[1,9] = 'F9h' then bpbList.Cells[1,9]:=' накопитель - 2 стороны, 9 секторов'

else if bpbList.Cells[1,9] = 'F0h' then bpbList.Cells[1,9]:=' накопитель - 2 стороны, 15 секторов';

bpbList.Cells[1,10]:=intToStr(buffer[$F+9] shl 8 + buffer[$F+8]);

bpbList.Cells[1,11]:=intToStr(buffer[$F+11] shl 8 + buffer[$F+10]);

bpbList.Cells[1,12]:=intToStr(buffer[$F+13] shl 8 + buffer[$F+12]);

bpbList.Cells[1,13]:=intToStr(buffer[$F+17] shl 32 + buffer[$f+16]+ buffer[$f+15]+buffer[$f+14]);

bpbList.Cells[1,14]:=intToStr(buffer[$F + 21] shl 24 + buffer[$F + 20] shl 16 + buffer[$F + 19] shl 8 + buffer[$F + 18]);

bpbList.Cells[1,15]:=intToStr(buffer[$C + 25]);

bpbList.Cells[1,16]:=intToStr(buffer[$F + 23]);

bpbList.Cells[1,17]:=intToStr(buffer[$F + 24]);

bpbList.Cells[1,18]:=intToHex((buffer[$F + 28] shl 24 + buffer[$F + 27] shl 16 + buffer[$F + 26] shl 8 + buffer[$F + 25]),8);

//-----------вывод метки -----------

s:='';

for i:=29 to 40 do

s:=s+chr(buffer[$F+i]);

bpbList.Cells[1,19]:= s;

s:='';

//----------------------------------

//-- чтение ID ОС-------------

for i:= 55 to 62 do

s:=s+ chr(buffer[i]);

bpbList.Cells[1,20]:= s;

s:='';

//----------------------------

end

else

ShowMessage('Не удалось считать блок параметров Bios');

end;

// чтение данных из структуры DriveInfo

procedure TForm3.Button3Click(Sender: TObject);

var

i,j,k:integer;

read:Cardinal;

s:string;

buffer: array[1..131072] of byte;

begin

Memo2.Clear;

if ReadSectors(hMBRDrive,0,1,@buffer,DiscGeometry.BytesPerSector) = DiscGeometry.BytesPerSector then

begin

for i:= 1 to 16 do

Grid2.Cells[i,0]:=intToHex((i-1),1);

i:=1; j:=1; k:=1;

while k<=DiscGeometry.BytesPerSector do

begin

if i=1 then Grid2.Cells[0,j]:=IntToHex(((j-1)*16+(i-1)),3);

Grid2.Cells[i,j]:=IntToHex(Buffer[k],2);

inc(k);

inc(i);

if i>16 then

begin

i:=1;

j:=j+1;

Grid2.RowCount:= Grid2.RowCount+1;

end;

end;

// Расшифровка PartitionTable

// первая часть

Memo2.Text:=Memo2.Text+'Первый элемент таблицы разделов системного диска: '+#13#10;

Memo2.Text:=Memo2.Text+'Признак загрузки: '+intToHex(buffer[$1bf],2)+#13#10;

Memo2.Text:=Memo2.Text+'Начало раздела диска{';

Memo2.Text:=Memo2.Text+'Головка: '+intToStr(buffer[448]);

Memo2.Text:=Memo2.Text+' Сектор: '+intToStr(buffer[449]);

Memo2.Text:=Memo2.Text+' Цилиндр: '+intToStr(buffer[450]);

Memo2.Text:=Memo2.Text+' }'+#13#10;

Memo2.Text:=Memo2.Text+'Тип раздела {';

Memo2.Text:=Memo2.Text+'Ос: '+intToStr(buffer[451]);

Memo2.Text:=Memo2.Text+' }'+#13#10;

Memo2.Text:=Memo2.Text+'Конец раздела диска{';

Memo2.Text:=Memo2.Text+'Головка: '+intToStr(buffer[$1c4]);

Memo2.Text:=Memo2.Text+' Сектор: '+intToStr(buffer[$1c5]);

Memo2.Text:=Memo2.Text+' Цилиндр: '+intToStr(buffer[$1c6]);

Memo2.Text:=Memo2.Text+' }'+#13#10;

Memo2.Text:=Memo2.Text+'Номер Сектора {';

Memo2.Text:=Memo2.Text+': '+intToStr(buffer[458]shl 32+buffer[457]+buffer[456]+buffer[455]);

Memo2.Text:=Memo2.Text+' }'+#13#10;

Memo2.Text:=Memo2.Text+'Размер раздела {';

Memo2.Text:=Memo2.Text+': '+intToStr(buffer[462]shl 24 +buffer[461] shl 16 +buffer[460]shl 8+buffer[459]);

Memo2.Text:=Memo2.Text+' }'+#13#10+#13#10+#13#10;

//вторая часть

Memo2.Text:=Memo2.Text+'Второй элемент таблицы разделов системного диска: '+#13#10;

Memo2.Text:=Memo2.Text+'Признак загрузки: '+intToHex(buffer[$1CF],2)+#13#10;

Memo2.Text:=Memo2.Text+'Начало раздела диска{';

Memo2.Text:=Memo2.Text+'Головка: '+intToStr(buffer[465]);

Memo2.Text:=Memo2.Text+' Сектор: '+intToStr(buffer[466]);

Memo2.Text:=Memo2.Text+' Цилиндр: '+intToStr(buffer[467]);

Memo2.Text:=Memo2.Text+' }'+#13#10;

Memo2.Text:=Memo2.Text+'Тип раздела {';

Memo2.Text:=Memo2.Text+'Ос: '+intToStr(buffer[468]);

Memo2.Text:=Memo2.Text+' }'+#13#10;

Memo2.Text:=Memo2.Text+'Конец раздела диска{';

Memo2.Text:=Memo2.Text+'Головка: '+intToStr(buffer[469]);

Memo2.Text:=Memo2.Text+' Сектор: '+intToStr(buffer[470]);

Memo2.Text:=Memo2.Text+' Цилиндр: '+intToStr(buffer[471]);

Memo2.Text:=Memo2.Text+' }'+#13#10;

Memo2.Text:=Memo2.Text+'Номер Сектора {';

Memo2.Text:=Memo2.Text+': '+intToStr(buffer[$1D7+3]shl 24+buffer[$1D7+2] shl 16+buffer[$1D7+1]shl 8 +buffer[$1D7]);

Memo2.Text:=Memo2.Text+' }'+#13#10;

Memo2.Text:=Memo2.Text+'Размер раздела {';

Memo2.Text:=Memo2.Text+': '+intToStr(buffer[$1db+3]shl 24 +buffer[$11db+2] shl 16 +buffer[$1db+1]shl 8+buffer[$1db]);

Memo2.Text:=Memo2.Text+' }'+#13#10+#13#10+#13#10;

end

else

ShowMessage('Не удалось считать PartitionTable');

end;

// получение инфо о нужных дисках

procedure TForm3.FormActivate(Sender: TObject);

var

S,SOut : String;

i:Integer;

VolumeName,FileSystemName,NewDiscNumber : String;

MaxComponentLength,FileSystemFlags:LongWord;

// от переменной VolumeSerialNo : DWord;

begin

S:=GetDisks(DiskHDD); {Получаем список Жёстких дисков (Параметр DiskHDD)}

s:=s+GetDisks(DiskFDD);

s:=s+GetDisks(DiskNet);

s:=s+GetDisks(DiskCDROM);

s:=s+GetDisks(DiskRAM);

SOut:='';

For i:=1 to Length(S) do {Получаем информацию о всех дисках и пишем в TLabel на форме}

begin

{Если диск существует/вставлен ...}

if GetHDDInfo(S[I], VolumeName, FileSystemName,NewDiscNumber,

MaxComponentLength, FileSystemFlags) then {... тогда собираем информацию}

SOut:=SOut+

'Диск: '+S[I]+#13#10+

'Метка: '+VolumeName+#13#10+

'Файловая система: '+FileSystemName+#13+#10+

'Серийный номер: '+NewDiscNumber+#13+#10+

'Макс. длина имени файла: '+IntToStr(MaxComponentLength)+#13+#10+

'Flags: '+IntToHex(FileSystemFlags,4)+#13#10+#13#10;

end;

Disks.Caption:=SOut; {Выводим в компонент TLabel полученные данные о дисках}

end;

end.

5) Модуль ThrdRcvr (модуль описывающий работу потока - приёмника сообщений):

unit ThrdRcvr; // принимающий поток

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs,StdCtrls, Buttons, Menus, ComCtrls, ActnMan, ActnColorMaps;

type

TThreadReceiver = class(TThread)

private

PBaseAdress:PChar;

TextString:String;

nlineSize:integer;

protected

procedure Execute; override;

public

end;

implementation

uses

Unit1;

// Считываем соержимое из проекции файла в Memo1

procedure TThreadReceiver.Execute;

begin

while (not terminated) do

begin

WaitForSingleObject(Form1.HEvent, INFINITE);

ResetEvent(Form1.HEvent);

try

// резерв. память в потоке для этотой проекции

PBaseAdress:=MapViewOfFile(Form1.HFileSender, FILE_MAP_READ,0,0,65536);

if (PBaseAdress = nil) then

begin

CloseHandle(Form1.HFileSender);

st:='не удалось отобразить файл на адресное пространство';

Application.MessageBox(st,'Сообщение...',MB_OK);

form1.BitBtn2.Visible:=false;

form1.Button1.Visible:=false;

exit;

end;

nlineSize:=integer(PBaseAdress^);

SetLength(TextString,nlineSize);

CopyMemory(PChar(TextString),Pointer(Integer(PBaseAdress)+4),nlineSize);

Form1.Memo1.Text:=Form1.Memo1.Text+'---------'+#13#10;

Form1.Memo1.Text:=Form1.Memo1.Text+TextString+#13#10;

sendmessage(Form1.memo1.handle, em_linescroll, 0, Form1.memo1.lines.count-1);

UnmapViewOfFile(PBaseAdress);

finally

end;

end;

end;

end.

6) Модуль HDDInfo (модуль получающий информацию о жёстких дисках):

unit HDDInfo;

interface

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

Dialogs, StdCtrls, FileCtrl, ExtCtrls, Grids, ValEdit;

const {Константы для TypeOfDisk функции GetDisks}DiskUnknown=0; {Неизвестные диски}

DiskNone=1; {Отсутствующие диски}

DiskFDD=DRIVE_REMOVABLE; {Съёмные диски, дискеты}

DiskHDD=DRIVE_FIXED; {Не съёиные диски, жёсткие диски}

DiskNet=DRIVE_REMOTE; {Сетевые диски}

DiskCDROM=DRIVE_CDROM; {CD ROM}

DiskRAM=DRIVE_RAMDISK; {Диски в ОЗУ}

function GetDisks(TypeOfDisk : Word) : String;

function GetHDDInfo(Disk : Char;Var VolumeName, FileSystemName,NewDiscNumber : String;

MaxComponentLength, FileSystemFlags:LongWord) : Boolean;

implementation

//получить имена доступных дисков

function GetDisks(TypeOfDisk : Word) : String;{Получить имена нужных дисков}

var

DriveArray : array[1..26] of Char;

i:integer;

beginDriveArray:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';

for i:= 1 to 26 do

if GetDriveType(PChar(DriveArray[I]+':\')) = TypeOfDisk then

Result := Result+DriveArray[I];

end;

// определение правильного серийного номера диска

function GetReplaceCDNumber(num: String): String;

var

i, len: Integer;

begin

Result:= '';

len:= Length(num);

if len <> 8 then exit;

for i:= 1 to (len div 2) do begin

Dec(len);

Result:= Result + num[len];

Result:= Result + num[len+1];

Dec(len);

end;

end;

// получить инфо о дисках с нужными именами

function GetHDDInfo(Disk : Char;Var VolumeName, FileSystemName,NewDiscNumber : String;

MaxComponentLength, FileSystemFlags:LongWord) : Boolean;

var

_VolumeName,_FileSystemName:array [0..MAX_PATH-1] of Char;

_VolumeSerialNo,_MaxComponentLength,_FileSystemFlags:LongWord;

_NewDiscNumber:string;

begin

if GetVolumeInformation(PChar(Disk+':\'),_VolumeName,MAX_PATH,@_VolumeSerialNo,

_MaxComponentLength,_FileSystemFlags,_FileSystemName,MAX_PATH) then

begin

NewDiscNumber:=IntToHex(integer(_VolumeSerialNo),8);

NewDiscNumber:=GetReplaceCDNumber(NewDiscNumber);

VolumeName:=_VolumeName;

MaxComponentLength:=_MaxComponentLength;

FileSystemFlags:=_FileSystemFlags;

FileSystemName:=_FileSystemName;

Result:=True;

end

else

Result:=False;

end;

end.

Список литературы:

1) М. Фленов «Библия Delphi»

2) А. Танцер «Синхронизация процессов при работе с Windows»

3) Сайт CitForum > http://citforum.ru/programming/delphi/disk_editor/ </

4)Cайт Delphi-Faq > http://delphi-faq.zoxt.net/a79.htm <.

5) Cайт DelphiSource.

Размещено на Allbest.ru