| Новости | Win API | VCL | Прочее | Железо |
| Как определить букву CD-ROM ? |
procedure TForm1.Button1Click(Sender:
TObject); |
| procedure TForm1.Button1Click(Sender: TObject); var SerialNum:Pdword; a,b:Dword; buffer:array [0..255] of char; begin new(SerialNum); if getVolumeInformation('c:\',buffer,sizeof(buffer),SerialNum,a,b,nil,0) then label1.Caption:=IntToStr(SerialNum^); Dispose(SerialNum); end; |
P.S.: на самом деле определяет серийный номер раздела(ов) на HDD, например
диск С: есть логический раздел винта. Серийный номер, получаемый вышеописанным способом, есть серийный номер логического раздела , который формирует прога Format и ей подобные, и ничего обсчего с серийным номером HDD не имеет.
Под ДОС данный S/N HDD получается путем прямого обращения к протам контроллера HDD (см. прогу IDInfo, для IDE винтов). Под W95/98 такая фишка прокатывает только через vxd-драйвер.
Под Delphi5 есть набор компонентов TVichW32 в котором есть функция определения S/N HDD и много много другого.
С уважением, Мельченков Дмитрий.
| uses ...,mmsystem; ..... begin ..... mciSendString('Set cdaudio Door Open Wait', nil, 0, handle); ..... end; |
| // Отключить : SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0); // Включить : |
| // win 95/98 : SetSystemPowerState(Suspended, Mode: Boolean):boolean; // Suspended : true - в спячку, false - назад // Mode : true - безусловный, false - может быть получен отказ. |
| //проверяет
существование указанного диска function DriveExists(Drive:Byte):Boolean; var Drives: set of 0..25; begin integer(Drives):=GetLogicalDrives; Result:=Drive in Drives end; // возвращает тип диска,
если диск есть |
| // Из реестра. См.
пример. // Пример: uses Registry; procedure TForm1.Button1Click(Sender: TObject); var reg : TRegistry; ts : TStrings; i : integer; begin reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE; reg.OpenKey('hardware\devicemap\serialcomm', false); ts := TStringList.Create; reg.GetValueNames(ts); for i := 0 to ts.Count -1 do begin Memo1.Lines.Add(reg.ReadString(ts.Strings[i])); end; ts.Free; reg.CloseKey; reg.free; end; |
| // может не
работать с определенными программами и
драйверами procedure TForm1.Button1Click(Sender: TObject); var CommPort : string; hCommFile : THandle; ModemStat : DWord; begin CommPort := 'COM2'; {Open the comm port} hCommFile := CreateFile(PChar(CommPort), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if hCommFile = INVALID_HANDLE_VALUE then begin ShowMessage('Не могу открыть '+ CommPort); exit; end; {Get the Modem Status} if GetCommModemStatus(hCommFile, ModemStat) <> false then begin if ModemStat and MS_CTS_ON <> 0 then ShowMessage('The CTS (clear-to-send) is on.'); if ModemStat and MS_DSR_ON <> 0 then ShowMessage('The DSR (data-set-ready) is on.'); if ModemStat and MS_RING_ON <> 0then ShowMessage('The ring indicator is on.'); if ModemStat and MS_RLSD_ON <> 0 then ShowMessage('The RLSD (receive-line-signal-detect) is on.'); end; {Close the comm port} CloseHandle(hCommFile); end; |
Как проверить готовность диска без появления окна ошибки Windows? |
| // Вы можете
использовать функцию Windows API SetErrorMode() // для отключения диалога Window's critical Error. function IsDriveReady(DriveLetter : char) : bool; var OldErrorMode : Word; OldDirectory : string; begin OldErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX); GetDir(0, OldDirectory); {$I-} ChDir(DriveLetter + ':\'); {$I+} if IoResult <> 0 then Result := False else Result := True; ChDir(OldDirectory); SetErrorMode(OldErrorMode); end; procedure TForm1.Button1Click(Sender: TObject); begin if not IsDriveReady('A') then ShowMessage('Диск не готов') else ShowMessage('Диск готов'); end; |
| //
Воспользуйтесь функцией GetSystemMetrics(), // переслав ей флаг SM_NETWORK. procedure TForm1.Button1Click(Sender: TObject); begin if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then ShowMessage('Компьютер подключен к сети') else ShowMessage('Компьютер не подключен к сети'); end; |
| // CD может иметь
или не иметь серийный номер // и/или универсальный код продукта (Universal Product Code). // MCI-расширение Windows предоставляет эту информации // с помощью комманды MCI_INFO_MEDIA_IDENTITY command // Эта команда возвращает уникальную ID-строку.
|
| function IsAudioCD(Drive : char) : bool; var DrivePath : string; MaximumComponentLength : DWORD; FileSystemFlags : DWORD; VolumeName : string; Begin result := false; DrivePath := Drive + ':\'; if GetDriveType(PChar(DrivePath)) <> DRIVE_CDROM then exit; SetLength(VolumeName, 64); GetVolumeInformation(PChar(DrivePath),PChar(VolumeName), Length(VolumeName),nil,MaximumComponentLength,FileSystemFlags,nil,0); if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then result := true; end; |
| var Computer : Array[1..500] of String[25]; ComputerCount : Integer; procedure FindAllComputers(Workgroup: String); Var EnumHandle : THandle; WorkgroupRS : TNetResource; Buf : Array[1..500] of TNetResource; BufSize : Integer; Entries : Integer; Result : Integer; begin ComputerCount := 0; Workgroup := Workgroup + #0; FillChar(WorkgroupRS, SizeOf(WorkgroupRS) , 0); With WorkgroupRS do begin dwScope := 2; dwType := 3; dwDisplayType := 1; dwUsage := 2; lpRemoteName := @Workgroup[1]; end; WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @WorkgroupRS, EnumHandle ); Repeat Entries := 1; BufSize := SizeOf(Buf); Result := WNetEnumResource( EnumHandle, Entries, @Buf, BufSize ); If (Result = NO_ERROR) and (Entries = 1) then begin Inc( ComputerCount ); Computer[ ComputerCount ] := StrPas(Buf[1].lpRemoteName); end; Until (Entries <> 1) or (Result <> NO_ERROR); WNetCloseEnum( EnumHandle ); end; { Find All Computers } |
| // Проверено по Вин95 (M.Scheduler
M_Scheduler@Yahoo.com) // Пример: if not ExitWindowsEx(EWX_Force or EWX_PowerOff or EWX_ShutDown, 0) then MessageBox(0, 'An application refused to terminate', 'Win32', MB_OK); |
