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);