Работа с железом
Вы уж простите, что на сях... сподручней было :\
Исходный код
- Подробности
- Родительская категория: Работа с железом
- Категория: CD-ROM/CD-R/CD-RW
Code: |
GetLogicalDrives() GetDriveType() |
- Подробности
- Родительская категория: Работа с железом
- Категория: CD-ROM/CD-R/CD-RW
Code: |
unit frmMain;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, MMSystem;
type TForm1 = class(TForm) Memo1: TMemo; Button2: TButton; Button3: TButton; procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private function IsAudioCD(Drive: char): bool; public end;
var Form1: TForm1;
implementation
{$R *.DFM}
function TForm1.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 begin 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; end;
procedure TForm1.Button2Click(Sender: TObject); begin if IsAudioCD(' D ') then showmessage('Cd is an audio cd') else showmessage('Cd is not an audio cd'); end;
procedure TForm1.Button3Click(Sender: TObject); type TDWord = record High: Word; Low: Word; end; var msp: TMCI_INFO_PARMS; MediaString: array[0..255] of char; ret: longint; I: integer; StatusParms: TMCI_STATUS_PARMS; MciSetParms: TMCI_SET_PARMS; MciOpenParms: TMCI_OPEN_PARMS; aDeviceID: MCIDEVICEID;
function GetTheDeviceID: MCIDEVICEID; begin FillChar(MciOpenParms, SizeOf(MciOpenParms), #0); try MciOpenParms.lpstrDeviceType := 'cdaudio'; ret := mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE + MCI_OPEN_SHAREABLE, LongInt(@MciOpenParms)); Result := MciOpenParms.wDeviceID; except on E: Exception do begin Result := 0; showmessage('error receiving deviceIDt' + #13 + SysErrorMessage(GetLastError) + #13 + E.Message); end; end; end;
function GetTrackInfo(const uMsg: UInt; const fdwCommand: DWord; const dwItem: DWord; const dwTrack: DWord): string; begin Result := 'Did not work...'; FillChar(MediaString, SizeOf(MediaString), #0); FillChar(StatusParms, SizeOf(StatusParms), #0); StatusParms.dwItem := dwItem; StatusParms.dwTrack := dwTrack; ret := mciSendCommand(aDeviceID, uMsg, fdwCommand, longint(@StatusParms)); if Ret = 0 then Result := IntToStr(StatusParms.dwReturn); end;
procedure SetTimeInfo; begin FillChar(MciSetParms, SizeOf(MciSetParms), #0); MciSetParms.dwTimeFormat := MCI_FORMAT_MSF; ret := mciSendCommand(aDeviceID {Mp.DeviceId}, MCI_SET, MCI_SET_TIME_FORMAT, longint(@MciSetParms)); if Ret <> 0 then Showmessage('Error convering timeformat...'); end;
begin Memo1.Clear; aDeviceID := GetTheDeviceID; Application.ProcessMessages; Memo1.Lines.Add('Track info :'); SetTimeInfo; Memo1.Lines.Add('Tracks: ' + GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM, MCI_STATUS_NUMBER_OF_TRACKS, 0)); Memo1.Lines.Add(' '); for I := 1 to StrToInt(GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM, MCI_STATUS_NUMBER_OF_TRACKS, 0)) do begin Memo1.Lines.Add('Track ' + IntToStr(I) + ' : ' + IntToStr(MCI_MSF_MINUTE (StrToInt(GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM + MCI_TRACK, MCI_STATUS_LENGTH, I)))) + ':' + IntToStr(MCI_MSF_SECOND(StrToInt(GetTrackInfo(MCI_STATUS, MCI_STATUS_ITEM + MCI_TRACK, MCI_STATUS_LENGTH, I))))); end; Application.ProcessMessages; end;
end. |
- Подробности
- Родительская категория: Работа с железом
- Категория: CD-ROM/CD-R/CD-RW
Находим в интернете файл ASPI.pas (еще есть wnaspi32.pas), подключаем его к проекту, пишем следующий код:
- Подробности
- Родительская категория: Работа с железом
- Категория: CD-ROM/CD-R/CD-RW
лазерный диск имеет свой идентификатор. Если сохранить, какому диску соответствует какой идентификатор, то можно реализовать определение диска.
В этой программе при нажатии на кнопку происходит проверка, есть ли название этого диска в файле. Если есть, то в заголовок окна выводится его название, если нет, то введенное пользователем название диска сохраняется в файл.
- Подробности
- Родительская категория: Работа с железом
- Категория: CD-ROM/CD-R/CD-RW
Code: |
mciSendString('Set cdaudio Door Open Wait', nil, 0, handle); mciSendCommand(mp.DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0); |
- Подробности
- Родительская категория: Работа с железом
- Категория: CD-ROM/CD-R/CD-RW
Code: |
var DriveType: UInt;
DriveType := GetDriveType(PChar('F:\')); if DriveType = DRIVE_CDROM then ShowMessage('Сидюк'); |
- Подробности
- Родительская категория: Работа с железом
- Категория: CD-ROM/CD-R/CD-RW
Code: |
function GetCDIcon(Drive: Char): TIcon; var ico: TIcon; ini: TIniFile; s, p: string; i, j: Integer; begin //Abbrechen wenn "AutoRun.Inf" nicht existiert. //Abort if "AutoRun.inf" doesn't exists. if FileExists(Drive + ':\autorun.inf') = False then Exit;
//"AutoRun.inf" offnen //Opens the "AutoRun.inf" ini := TIniFile.Create(Drive + ':\autorun.inf'); ico := TIcon.Create;
try //Dateinamen lesen //Read the filename s := ini.ReadString('Autorun', 'ICON', '');
//Abbrechen, wenn kein Icon festgelegt wurde //Abort if there is no icon specified if s = '' then Exit;
//Icon von Datei laden //load the icon from a file if FileExists(s) then ico.LoadFromFile(s); if FileExists(Drive + ':\' + s) then ico.LoadFromFile(Drive + ':\' + s);
//Icon aus einer Resource laden //Load the icon from a Win32 resource if (FileExists(s) = False) and (FileExists(Drive + ':\' + s) = False) then begin for j := (Pos(',', s) + 1) to Length(s) do begin p := p + s[j]; end; i := StrToInt(p); for j := Length(s) downto (Pos(',', s)) do Delete(s, j, Length(s));
if FileExists(s) = False then s := Drive + ':\' + s;
ico.Handle := ExtractIcon(hinstance, PChar(s), i); end;
Result := ico; finally ini.Free; end; end; |
- Подробности
- Родительская категория: Работа с железом
- Категория: CD-ROM/CD-R/CD-RW
Можно использовать функцию Windows API GetDriveType() чтобы определить является ли дисковод CD-ROM'мом. И функцию API GetVolumeInformation() чтобы проверить VolumeName на равенство 'Audio CD'.
Пример:
- Подробности
- Родительская категория: Работа с железом
- Категория: CD-ROM/CD-R/CD-RW
DriveTools 1.0 Jan Peter Stotz If you find bugs, has ideas for missing featurs, feel free to contact me Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.
- Подробности
- Родительская категория: Работа с железом
- Категория: CD-ROM/CD-R/CD-RW
Code: |
function GetNumberOfCDDrives: Byte; var drivemap, mask: DWORD; i: integer; root: string; begin Result := 0; root := 'A:\'; drivemap := GetLogicalDrives; mask := 1; for i := 1 to 32 do begin if (mask and drivemap) <> 0 then if GetDriveType(PChar(root)) = DRIVE_CDROM then begin Inc(Result); end; mask := mask shl 1; Inc(root[1]); end; end;
procedure TForm1.Button1Click(Sender: TObject); begin Label1.Caption := IntToStr(GetNumCDDrives); end; |
- Подробности
- Родительская категория: Работа с железом
- Категория: CD-ROM/CD-R/CD-RW
Страница 2 из 17