[Delphi] Wlasny file system

[Toster]

Ok, na wszystkich swietych mialem troche czasu oraz spokoju (oraz kompilator delphi ;) ). Jakis czas temu byl tez post kogs o pisaniu wlasnego OS'a w sumie az takich aspiracji nie mam, ale pomyslalem sobie ze jakiegos prostego filesystema mozna sprawdzic czy bym samodzielnie napisal. Tak powstalo to cos co mozna zobaczyc tutaj. Calosc pisalem 2 dni wiec to nic nadzwyczajnego ale jako wprawka do czegos powazniejszego mysle ze sie nada. Kod:
Delphi
{Virtual Disk & OS Engine by Toster
The Tosters, 2006
web: toster.ps.pl
email: toster@ps.pl
}
unit VDEngine;

{ 07.11.2006
Krotkie info, kod zostal napisany bez wiekszego przemyslenia czy planowania
w 'ferworze tworczym'. Glownym celem dla ktorego powstal bylo sprawdzenie czy
potrafie cos takiego napisac. Przy okazji stwierdzilem ze moze kogos
zainteresowac wiec go upubliczniam.
Po krotkiej analizie widac ze czesto korzystam z klasy TStrings jako kontenera
do przekazywania danych, nie jest to ani optymalne(pod roznymi wzgledami) ani
eleganckie ale bylo proste i szybkie w implementacji dlatego zostalo uzyte.
Niektore pola w roznych klasach moga byc nie uzywane lub nie dokladnie
aktualizowane gdyz poczatkowo mogly sie mi wydac potrzebne, a pozniej moglo
sie to zmienic. Wniosek z tego taki ze kod nie jest wyczyszczony ani
optymalizowany i zapewne nigdy nie bedzie.
Metoda sprawdzajaca integralnosc danych na dysku jest bardzoooo uproszczona
i niedokonczona wiec nie nalezy sie nia zbyt przejmowac w chwili obecnej.
Jesli kod wydal ci sie ciekawy i pomogl ci w czym cieszy mnie to bardzo jesli
nie trudno musze z tym zyc :)
Toster
}

interface
uses classes, sysutils, Math;

type
TFileSystem = class;
TSimpleFile = class;
TRealBlock = array of byte;
TLogicBlock = array of byte;
TIntArray = array[0..0] of integer;
PIntArray = ^TIntArray;

{ Klasa odpowiedzialna za symulowanie dzialania dysku, oferuje podstawowa
funkcjonalnosc fizycznego urzadzenia. Podstawowa jednostka na ktorej mozliwe
sa operacje jest jeden blok. Dano uzytkownikowi mozliwosc ustalania zarowno
liczby blokow jak i wielkosci bloku. Dodano mozliwosc zachowywania
danych w pliku, w celu zwiekszenia elastycznosci klasy, oraz umozliwienia
mountowania roznych dyskow
}
TDisk = class
public
constructor Create(const blockSize:integer; const blocks:integer);
destructor Destroy;override;
procedure WriteBlock(const blockNr:integer; const Data:TRealBlock);
procedure ReadBlock(const blockNr:integer; var Data:TRealBlock);
procedure LinkToFile(const name:string);
private
fData: array of TRealBlock;
fBlockSize: integer;
fBlockCount: integer;
fFileName: string;
fFileMap: TFileStream;
published
property BlockSize: integer read fBlockSize;
property BlocksCount: integer read fBlockCount;
property FileName: string read fFileName;
end;

TDiskInt = (diUnknown, diOk, diCorrupted);

TRealBlockType = (btUnused, btFile, btFileList, btControlBlock);

PRealBlockHeader = ^TRealBlockHeader;
{propozycja naglowka dla kazdego bloku zapisanego na dysku,
umozliwia tworzenie kolejki dwukierunkowej oraz podzial funkcjonalny
dysku.}
TRealBlockHeader = record
fBlockNR: integer;
fBlockType: TRealBlockType;
fDataStart: integer;
fNextInChin:integer; //kolejny blok jesli taki jest
fPrevInChain:integer; //poprzedni blok
end;

{Klasa obudowujaca podstawowa funkcjonalnosc prostego systemu dyskowego
umozliwia mountowanie/demountowanie pojedynczego dysku, oraz podstawowe
operacje na dysku (odczyta/zapis blokow logicznych, odczyt/zapis/listowanie
plikow). W zaleznosci od typu systemu plikow mozliwe jest wprowadzenie
bardziej zaawansowanej funkcjonalnosci, bez znaczacych zmian w tej klasie
}
TSimpleOS = class
public
constructor Create;
destructor destroy;override;
procedure MountDisk(const disk:TDisk);
procedure UnMountDisk(const disk:TDisk);
procedure Format(const disk:TDisk);
procedure ChcekIntegrity(const disk:TDisk);
procedure WriteBlock(const blockNr:integer; const Data:TLogicBlock; const typ:TRealBlockType ;const next,prev:integer);
procedure ReadBlock(const blockNr:integer; var Data:TLogicBlock);
function GetFreeBlockNr:integer;
procedure MarkFreeBlock(const blockNr:integer; const IsFree:boolean);
procedure WriteData(const name:string; const data:TStream);
procedure ReadData(const name:string; const data:TStream);
function HasAvailBlocks(const wantedBlocks:integer):Boolean;
procedure GetFilesList(const FileList:TStrings);
procedure DeleteFile(const name:string);
private
fDisk: TDisk;
fIntegrity: TDiskInt;
fMessages: TStrings;
fFirstControlBl:integer; //od tego bloku zaczyna sie lancuch z referencjami do wolnych blokow
fFileStructBl: integer; //od tego bloku zaczyna sie lancuch z referencjami do plikow
fFileSystem: TFileSystem;
procedure ReadChain(const ChainStart:integer; const OutData:TStream);
published
property Messages:TStrings read fMessages;
property Disk: TDisk read fDisk;
property FileSystem: TFileSystem read fFileSystem;
end;

{Klasa abstrakcyjna proponowana jako rodzic dla wszelakich systemow plikow
ktore moga byc podlaczone do przykladowego OS'a
}
TFileSystem = class
public
function WriteStructure:boolean;virtual;abstract;
procedure ReadStructure(const startBlock:integer);virtual;abstract;
procedure CreateEmptyStructure(const startBlock:integer);virtual;abstract;
function FileExist(const name:string):boolean;virtual;abstract;
procedure AddFile(const name:string;const size:integer; const blocks:TStrings);virtual;abstract;
procedure DelFile(const name:string);virtual;abstract;
procedure GetChain(const ChainType:TRealBlockType;const ChainName:string;const blocks:TStrings);virtual;abstract;
function GetFileSize(const name:string):integer;virtual;abstract;
procedure GetFilesList(const files: TStrings);virtual;abstract;
private
fStartBlock: integer; //numer bloku od ktorego zaczyna sie definicja struktur
end;

{Przyklad implementacji klasy obslugujacej system plikow, klasa posiada
podstawowa funkcjonalnosc dodawanie/kasowanie plikow, listowanie plikow
pobieranie informacji o pliku itp. W obecnej postaci klasa nie obsluguje
struktury katalogowej jest to zamierzone dzialanie ktorgo podstawowym celem
bylo maksymalne uproszczenie kodu
}
TSimpleFileList = class(TFileSystem)
public
constructor Create(const OS:TSimpleOs; const StartBlock:integer);
destructor Destroy;override;
private
fFiles: TList;
fOS: TSimpleOS;
procedure GetUsedBlocks(const str:TStrings);
public
function WriteStructure:boolean;override;
procedure ReadStructure(const startBlock:integer);override;
procedure CreateEmptyStructure(const startBlock:integer);override;
function FileExist(const name:string):boolean;override;
procedure AddFile(const name:string;const size:integer; const blocks:TStrings);override;
procedure DelFile(const name:string);override;
procedure GetChain(const ChainType:TRealBlockType;const ChainName:string;const blocks:TStrings);override;
function GetFileSize(const name:string):integer;override;
function GetFileNamed(const name:string):TSimpleFile;
procedure GetFilesList(const files: TStrings);override;
private
procedure Clear;
end;

{Klasa bedaca wezlem w ktorym sa trzymane krytyczne dla pliku informacje,
uzywana przez TSimpleFileList
}
TSimpleFile = class
public
constructor Create(const name:string; const size:integer; const blocks:TStrings);
destructor Destroy;override;
private
fName: string;
fBlocks: array of integer;
fSize: integer;
end;
implementation

constructor TSimpleFile.Create(const name:string; const size:integer; const blocks:TStrings);
var
t: integer;
begin
fName := name;
fSize := size;
SetLength(fBlocks, blocks.Count);
for t := 0 to blocks.Count-1 do
fBlocks[t] := StrToInt(blocks[t]);
end;

destructor TSimpleFile.Destroy;
begin
fBlocks := nil;
end;

constructor TSimpleFileList.Create(const OS:TSimpleOs; const StartBlock:integer);
var
data: TRealBlock;
bl: PRealBlockHeader;
begin
fFiles := TList.Create;
fOS := OS;
SetLength(data, os.fDisk.fBlockSize);
os.fDisk.ReadBlock(StartBlock, data);
//sprawdzamy czy ten blok jest wlasciwy ?
bl := PRealBlockHeader(@data[0]);
if bl^.fBlockType = btFileList then
ReadStructure(StartBlock)
else
CreateEmptyStructure(StartBlock);
data := nil;
end;

destructor TSimpleFileList.Destroy;
begin
Clear;
fFiles.Free;
end;

procedure TSimpleFileList.GetFilesList(const files: TStrings);
var
t: integer;
begin
files.Clear;
for t := 0 to fFiles.Count-1 do
files.Add( TSimpleFile(fFiles[t]).fName);
end;

procedure TSimpleFileList.Clear;
var
t: integer;
begin
for t := 0 to fFiles.Count-1 do
TSimpleFile(fFiles[t]).Free;
fFiles.Clear;
end;
procedure TSimpleFileList.GetChain(const ChainType:TRealBlockType;const ChainName:string;const blocks:TStrings);
var
t: integer;
fil: TSimpleFile;
begin
{Funkcja zwraca liste wszystkich blokow uzytych do przechowywania danych
na dysku. Kolejnosc blokow ma znaczenie !
Na podstwie tej funkcji nie da sie okreslic dokladnej wielkosci pliku, nalezy
skorzystac z GetFileSize.
}
if ChainType <> btFile then begin
fO

[KKKas]

Żeby nie było, że nikogo to nie zainteresowało, to:
Gratuluję, fajna sprawa ;-) Może kiedyś będę miał czas żeby to przeanalizować...

[Toster]

8)

[Wosiedem]

Też kiedyś robiłem coś podobnego, ale nie bardzo mi wyszło

Toster, brakuje mi jeszcze defragmentacji plików Jak zrobisz to potem musisz zrobić własną wirtualną maszynę!

[Toster]

nie kus :)

[sazian]

Noo.. tak bardzo ładne tylko jak to działa bo co bym nie zrobił to mi błąd wywala

(*******************************************************************)
dobra wim w czym jest błąd co powinno być w pliku C:Documents and SettingsaMoje dokumentyDiskMap.tmp ????

[Toster]

Plik o ktorym mowisz to reprezentacja twojego dysku :) Filesystem na nim operuje dzieki temu mozesz podmountowac dysk na ktorym juz pracowales i nie tworzyc go za kazdym razem od poczatku :)

[BlackGilmor]

Heh, no super sprawa, tylko gdzie można znaleźć cały kod, bo ten jest chyba urwany w połowie

[Toster]

Hmm.. no fakt tak wlasnie wyglada jak znajde go w chacie to wrzuce do dzialu artykuly, chyba ze admin moze zerknac co sie z baza danych dzieje