|
Программирование
FAQ
В этом разделе я
попытался собрать все наиболее часто
встречающиеся вопросы, касаемые
программирования в Дельфи, Паскале и Си. Если вы
можете пополнить список вопросов и ответов- пишите
Как
зашатдаунить NT?
Как программно
убить приложение?
Как программно
отформатировать диск в Win32?
Как узнать
серийный номер диска?
Как добавить
документ в меню ПУСК - ДОКУМЕНТЫ?
Как подключить
сетевой диск?
Проверка
включенности клавиш
Как узнать
параметры оперативной и виртуальной памяти?
Как узнать
путь к системному, текущему каталогу и к
каталогу, где расположен Windows?
Как узнать
частоту процессора?
Как узнать имя
текущего принтера?
Как узнать
платформу, версию ОС, номер версии?
Как
определить тип, букву носителя, объем и свободное
место?
Как изменить
обработчик события закрытия окна ?
Как
зарегистрировать в системе горячую клавишу и
назначить ей обработчик?
procedure Shutdown
(Name:String; // Имя машины
Message:String; // Сообщение
Delay:Integer; // Задержка перед
рестартом
Restart,CloseAll:Boolean);
var
ph:THandle;
tp,prevst:TTokenPrivileges;
rl:DWORD;
begin
OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or
TOKEN_QUERY,ph);
LookupPrivilegeValue(Nil,'SeShutdownPrivilege',tp.Privileges[0].Luid);
tp.PrivilegeCount:=1;
tp.Privileges[0].Attributes:=2;
AdjustTokenPrivileges(ph,FALSE,tp,SizeOf(prevst),prevst,rl);
InitiateSystemShutdown(PChar(name),PChar(Message),Delay,Restart,CloseAll);
ShowMessage(SysErrorMessage(GetLastError)); //
Результат
end;
К началу
Нужно отправить этому
приложению сообщение WM_QUIT
PostMessage(FindWindow(nil,'Заголовок
окна'), WM_QUIT, 0, 0);
Функция FindWindow
возвращает дескриптор окна. Первый параметр этой
функции- класс окна, второй - заголовок окна.
Функция PostMessage
отправляет сообщение оконному объекту. В данном
случае это сообщение WM_QUIT, а дескриптор окна
находится функцией FindWindow.
К началу
Для этого используется
функция ShFormatDrive() из модуля ShellAPI.
Пример:
const SHFMT_DRV_A = 0;
const SHFMT_DRV_B = 1;
const SHFMT_ID_DEFAULT = $FFFF;
const SHFMT_OPT_QUICKFORMAT = 0;
const SHFMT_OPT_FULLFORMAT = 1;
const SHFMT_OPT_SYSONLY = 2;
const SHFMT_ERROR = -1;
const SHFMT_CANCEL = -2;
const SHFMT_NOFORMAT = -3;
function SHFormatDrive(hWnd : HWND;Drive : Word;fmtID : Word;Options :
Word) : Longint
stdcall; external 'Shell32.dll' name 'SHFormatDrive';
procedure
TForm1.Button1Click(Sender: TObject);
var
FmtRes : longint;
begin
try
FmtRes:=
ShFormatDrive(Handle,SHFMT_DRV_A,SHFMT_ID_DEFAULT,SHFMT_OPT_QUICKFORMAT);
case FmtRes of
SHFMT_ERROR
: ShowMessage('Error formatting the drive');
SHFMT_CANCEL
: ShowMessage('User canceled formatting the drive');
SHFMT_NOFORMAT :
ShowMessage('No Format')
else
ShowMessage('Disk has been formatted');
end;// case
except
end; // try
end; // procedure
К началу
procedure TForm1.Button1Click(Sender:
TObject);
var
VolumeName,
FileSystemName : array [0..MAX_PATH-1] of Char;
VolumeSerialNo : DWord;
MaxComponentLength,
FileSystemFlags : Integer;
begin
GetVolumeInformation('C:\',VolumeName,MAX_PATH,@VolumeSerialNo,
MaxComponentLength,FileSystemFlags,
FileSystemName,MAX_PATH);
Memo1.Lines.Add('VName = '+VolumeName);
Memo1.Lines.Add('SerialNo = $'+IntToHex(VolumeSerialNo,8));
Memo1.Lines.Add('CompLen = '+IntToStr(MaxComponentLength));
Memo1.Lines.Add('Flags = $'+IntToHex(FileSystemFlags,4));
Memo1.Lines.Add('FSName = '+FileSystemName);
end;
К началу
Для этого
воспользуемся функцией SHAddToRecentDocs из модуля
ShlObj.
uses ShlOBJ;
procedure
TForm1.Button1Click(Sender: TObject);
var
s : string;
begin
s := 'C:\My Documents\APIFAQ.doc';
SHAddToRecentDocs(SHARD_PATH, pChar(s));
end;
К началу
procedure MapNetDrive;
var
nd:TNetResourceA;
begin
nd.dwType:=resourcetype_disk;
nd.lpLocalName:= 'x:'; //nd.lpLocalName:='x:',
'x'- буква диска
nd.lpRemoteName:='\\nethost\sharefolder\'; //nd.lpRemoteName:='\\nethost\sharefolder\'
- сетевой путь
nd.lpProvider:=nil;
WNetAddConnection2(nd,nil,nil),
end; //procedure
К началу
procedure CheckKey(Key: Word);
begin
case Key of
VK_CAPITAL:
if
GetKeyState(VK_CAPITAL) and 1 = 1 then
// что-нибудь делаем
else
//что-нибудь делаем
VK_INSERT:
if
GetKeyState(VK_INSERT) and 1 = 1 then
//
что-нибудь делаем
else
//что-нибудь делаем
VK_NUMLOCK:
if
GetKeyState(VK_NUMLOCK) and 1 = 1 then
//
что-нибудь делаем
else
//что-нибудь делаем
VK_SCROLL:
if
GetKeyState(VK_SCROLL) and 1 = 1 then
//
что-нибудь делаем
else
//что-нибудь делаем
end; //case
end; //procedure
К началу
procedure GetMemStatus(var
MemUse,MemPhysTotal,MemPhysFree,MemVirtTotal,MemVirtFree:string);
var
MS: TMemoryStatus;
begin
MS.dwLength := SizeOf(MS);
GlobalMemoryStatus(MS);
MemUse:=inttostr(MS.dwMemoryLoad)+'%'; // Используется
оперативной памяти в %
MemPhysTotal:=inttostr(MS.dwTotalPhys div 1024)+' kb';
// Всего
оперативной памяти в Кб
MemPhysFree:=inttostr(MS.dwAvailPhys div 1024)+' kb';
// Свободно
оперативной памяти в Кб
MemVirtTotal:=inttostr(MS.dwTotalVirtual div 1024)+' kb';
// Всего
виртуальной памяти в Кб
MemVirtFree:=inttostr(MS.dwAvailVirtual div 1024)+' kb';
// Свободно
виртуальной памяти в Кб
end; // procedure
К
началу
procedure GetDirInfo(var
WinDir,SysDir,CurDir:string);
var
S: array[0..MAX_PATH] of
char;
begin
{
Возвращает путь к каталогу, где расположен Windows }
GetWindowsDirectory(S,SizeOf(S));
WinDir:=s;
{
Возвращает путь к системному каталогу }
GetSystemDirectory(S,SizeOf(S));
SysDir:=s;
{
Возвращает путь к текущему каталогу }
GetCurrentDirectory(SizeOf(S),S);
CurDir:=s;
end; //procedure
К началу
procedure GetCPUSpeed(var
CPUSpeed:string);
const
DelayTime = 500;
var
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
Speed:Double;
begin
PriorityClass :=
GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
Sleep(10);
asm
dw 310Fh
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Speed := TimerLo / (1000.0 * DelayTime);
CPUSpeed:= Format('%f MHz', [Speed])
end; //procedure
К
началу
procedure GetPrintInfo(var
PrnName:string);
begin
if
Printer.Printers.Count>0 then
PrnName:=Printer.Printers[Printer.PrinterIndex]
else
PrnName:='Нет установленных принтеров';
end;
К
началу
procedure GetOSVerInfo(var
Platform,OSVer,Build:string);
var
VI: TOSVersionInfo;
begin
VI.dwOSVersionInfoSize :=
SizeOf(VI);
GetVersionEx(VI);
case VI.dwPlatformID of
VER_PLATFORM_WIN32S:Platform:='Windows 3.1x с Win32s'; //
установлена ОС Windows 3.1
//c Win32
VER_PLATFORM_WIN32_WINDOWS:Platform:='Windows 95/98'; //
установлена ОС Windows 95 //или 98
VER_PLATFORM_WIN32_NT:Platform:='Windows NT'; //
установлена ОС Windows NT или 2000
end; //case
OSVer:=Format('%d.%d', [VI.dwMajorVersion, VI.dwMinorVersion]);
Build:=Format('%d', [LoWord(VI.dwBuildNumber)]);
end;//procedure
К
началу
Добавьте в проект компоненты
ListView и TButton.
procedure TForm1.Button1Click(Sender:
TObject);
begin
CheckDrives;
end;
procedure CheckDrives;
var
i,j,Fr,SZ: Integer;
C: String;
DType: Integer;
DriveString,DriveType: String;
Ads: TListItem;
begin
Form1.ListView1.Items.Clear;
j:=0;
for i := 65 to
90 do
begin
j:=j+1;
C := chr(i)+':\';
DType := GetDriveType(PChar(C));
case DType of
0:
DriveString := C+' Невозможно определить тип
диска';
1:
DriveString := C+' Неправильно задан путь к
диску';
DRIVE_REMOVABLE:
begin
DriveString :=' '+C; // съемный
диск (дисковод)
DriveType:=' cъемный';
end;
DRIVE_FIXED: // жесткий диск
begin
DriveString :=' '+C;
DriveType:=' жесткий';
end;
DRIVE_REMOTE: // сетевой диск
begin
DriveString :=' '+C;
DriveType:=' cетевой';
end;
DRIVE_CDROM: // CD-ROM
begin
DriveString :=' '+C;
DriveType:=' CD ROM';
end;
DRIVE_RAMDISK: // RAM диск
begin
DriveString :=' '+C;
DriveType:=' RAM диск';
end;
end;
if not ((DType = 0) or
(DType = 1)) then
begin
FR:=DiskFree(j); //свободное
место
SZ:=DiskSize(j); //
емкость носителя
Ads:=Form1.ListView1.Items.Add ;
Ads.Caption:=(DriveString);
Ads.SubItems.Add('type');
Ads.SubItems.Strings[0]:=DriveType;
Ads.SubItems.Add('size');
Ads.SubItems.Strings[1]:=Inttostr(SZ
div (1024*1024));
Ads.SubItems.Add('free');
Ads.SubItems.Strings[2]:=Inttostr(FR
div (1024*1024));
end; //case
end; //for
end; //procedure
Поместите в раздел protected
описание процедуры WMGetSysCommand:
protected
procedure WMGetSysCommand(var Messag:
TMessage );message WM_SYSCOMMAND;
а в разделе implementation
поместите тело процедуры:
procedure TForm1.WMGetSysCommand(var
Messag: TMessage );
begin
if (Messag.wParam=
SC_CLOSE) then
begin
//
что-нибудь делаем
end
else
inherited; // обработчик
по умолчанию
end; //procedure
Поместите в раздел private
описание процедуры WMHotKey:
private
procedure WMHotKey(var
Msg : TWMHotKey); message WM_HOTKEY;
в разделе глобальных
переменных создадим переменную:
HK_ID : ATOM;
В обработчик создания окна
поместите след код:
procedure TForm1.FormCreate(Sender:
TObject);
begin
idrsh:=GlobalAddAtom('HK_ID'); // создаем
уникальный идентификатор "горячей" клавиши
RegisterHotKey(Form1.Handle,HK_ID,mod_alt,78);// регистрируем ее в системе
// 3-й параметр
функции RegisterHotKey показывает на наличие клавиш
Alt,Control или Shift
// 4-й параметр -
числовое значение клавиши
end; //procedure
// в обработчике
закрытия формы снимаем регистрацию
procedure TForm1.FormDestroy(Sender:
TObject);
begin
UnRegisterHotKey(Form1.Handle,HK_ID);
end; //procedure
// обработчик
нажатия "горячей" клавиши
procedure TForm1.WMHotKey (var
Msg : TWMHotKey);
begin
if Msg.HotKey =
HK_ID then
//
что-нибудь делаем
end; //procedure
| 
