Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.03.30;
Скачать: [xml.tar.bz2];

Вниз

Чтение данных системы...   Найти похожие ветки 

 
Ultimate ©   (2008-02-26 14:45) [0]

Какой командой можно получить имя жесткого диска (К примеру чтоб у меня вывело ST3120026A)? Или имя компьютера (которое задается при установке ОС)? Также как сделать запись параметра в реестр и чтение этого же параметра с реестра позже?


 
Thrasher ©   (2008-02-26 15:04) [1]


> Также как сделать запись параметра в реестр и чтение этого
> же параметра с реестра позже?

Tregistry никто не отменял.


> Какой командой можно получить имя жесткого диска (К примеру
> чтоб у меня вывело ST3120026A)?

http://home.earthlink.net/~akonshin/delphi_ru.htm - там есть как получить номер диска


 
Ultimate ©   (2008-02-26 15:28) [2]


> http://home.earthlink.net/~akonshin/delphi_ru.htm - там
> есть как получить номер диска

я нашел IdeSN2 но он просит что-то установить в винду. в ридми так что-то написано. да и мне он вечно ошибки пишет. мол устройство не подключено. а разбирать этот скрипт нет времени.
нашел это:
Hddinfo.pas
-------------------
unit HDDInfo;

interface

Uses Windows;

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;

{Функция получения информации о диске (HDD,FDD,CD) с буквой Disk}
{
Передаваемые значения:
Disk - Буква диска

Получаемые значения:
VolumeName - Метка/Имя тома
FileSystemName - Файловая система
VolumeSerialNo - Серийный номер диска (можно привязывать к диску программы)
MaxComponentLength - Максимальная длинна имени файла
FileSystemFlags - Флаги смотрите в справке Delphi по GetVolumeInformation

Функция возвращает true, если всё прошло успешно (диск нашёлся),
и false, если возникли проблемы, например диска нет в дисководе,
либо дисковода такого вообще нет
}
Function GetHDDInfo(Disk : Char;Var VolumeName, FileSystemName : String;
Var VolumeSerialNo, MaxComponentLength, FileSystemFlags:LongWord) : Boolean;

implementation

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

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

  I : integer;  

 
begin
DriveArray:="ABCDEFGHIJKLMNOPQRSTUVWXYZ";  

for I := 1 to 26 do  

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

    Result := Result+DriveArray[I];  

 
end;

Function GetHDDInfo(Disk : Char;Var VolumeName, FileSystemName : String;
 Var VolumeSerialNo, MaxComponentLength, FileSystemFlags:LongWord) : Boolean;
 Var
_VolumeName,_FileSystemName:array [0..MAX_PATH-1] of Char;  

_VolumeSerialNo,_MaxComponentLength,_FileSystemFlags:LongWord;  

 
Begin
if GetVolumeInformation(PChar(Disk+":"),_VolumeName,MAX_PATH,@_VolumeSerialNo,  

   _MaxComponentLength,_FileSystemFlags,_FileSystemName,MAX_PATH) then  

 
Begin  

 
VolumeName:=_VolumeName;  

VolumeSerialNo:=_VolumeSerialNo;  

MaxComponentLength:=_MaxComponentLength;  

FileSystemFlags:=_FileSystemFlags;  

FileSystemName:=_FileSystemName;  

Result:=True;  

 
End  

 
else  

  Result:=False;  

 
End;
end.

{-------}
Project.dpr
------------
program Project1;

{$APPTYPE CONSOLE}

uses
 SysUtils,
 Unit1 in "Unit1.pas",hddinfo;

var
 ss:tsearchrec;
 s,ff:string;
 i:integer;
begin
 { TODO -oUser -cConsole Main : Insert code here }
 writeln("vvedi imia fajla");
 readln(ff);
             {тут указать че сканить а че нет}
s:="";
S:=S+GetDisks(DiskHDD);
 S:=S+GetDisks(DiskCDROM);
 S:=S+GetDisks(DiskNet);
 S:=S+GetDisks(DiskRAM);

 for i:=1 to length(s) do
 begin
 scandir(s[i]+":",ff);
 end;
 readln;
//  write(ss.name);
end.

{-----}
Unit1.pas
----------

unit Unit1;

interface
uses sysutils,dialogs;
  Procedure ScanDir(Dir:string;filename:string);
implementation

Procedure ScanDir(Dir:string;filename:string);
var SearchRec:TSearchRec;
begin
if Dir<>"" then if Dir[length(Dir)]<>"" then Dir:=Dir+"";
if FindFirst(Dir+"*.*", faAnyFile, SearchRec)=0 then

repeat
if (SearchRec.name=".") or (SearchRec.name="..") then continue;
if (SearchRec.Attr and faDirectory)<>0 then
ScanDir(Dir+SearchRec.name,filename) //we found Directory: "Dir+SearchRec.name"
else
if filename = SearchRec.Name then write(Dir+SearchRec.name); //we found File: "Dir+SearchRec.name"
until FindNext(SearchRec)<>0;
FindClose(SearchRec);
end;
end.

{-----}

{-------}


но незнаю куда это воткнуть...


 
Palladin ©   (2008-02-26 15:29) [3]

ответ так и напрашивается... :)


 
Ultimate ©   (2008-02-26 15:37) [4]

понял я куда это. но в нем ошибка...
в hddinfo.pas в части
begin
DriveArray:="ABCDEFGHIJKLMNOPQRSTUVWXYZ";  
for I := 1 to 26 do  
  if GetDriveType(PChar(DriveArray[I]+":")) = TypeOfDisk then  
    Result := Result+DriveArray[I];

пишет что if GetDriveType(PChar(DriveArray[I]+":")) = TypeOfDisk then invalid typecast что мона сделать?


 
Ultimate ©   (2008-02-26 16:50) [5]

Как я понял собака зарыта в GetVolumeInformation(PChar Disk+":"),_VolumeName,MAX_PATH,@_VolumeSerialNo, _MaxComponentLength,_FileSystemFlags,_FileSystemName,MAX_PATH)
но в чем конкретно я непойму... как мне вынуть только серийный номер незнаю... :(


 
Ultimate ©   (2008-02-27 19:44) [6]

Щас проблема с реестром. Записал ключ через
RegFile := TRegIniFile.Create(SubKey);
RegFile.WriteString(StrKey, "Value", IntToStr(znach+555));


через редактор реестра вижу, что ключ на месте...
но когда прошу вывести значение ключа по команде
Edit2.Text:=RegFile.ReadString(StrKey, "Value", "");
Ничего не выходит... Пишет про EAccesViolation и адреса всякие...Если вместо RegFile.ReadString(StrKey, "Value", "") ввести строку, то всё нормально... Может что-то не так?



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.03.30;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.045 c
15-1203415250
Ega23
2008-02-19 13:00
2008.03.30
Что почитать про безопасность?


2-1204363054
makz
2008-03-01 12:17
2008.03.30
Запрос


2-1204288356
boba
2008-02-29 15:32
2008.03.30
Canvas.TextWidth


2-1204475915
Alex
2008-03-02 19:38
2008.03.30
Как оговорить свойство Lines для работы Memo?


2-1204113354
tytus
2008-02-27 14:55
2008.03.30
EndThread - закрывается приложение. Почему?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский