...use an Exe Internal Virtual File System @ RunTime?
Author: Cybergen
{*********************************************************************
This Sourcecode is Freeware i.e Credit-Ware:
you should say e.g. "Thanks to Cybergen"
if you use it in your software.
At least, it would be ^^ nice.
Cybergen <nope2k@web.de>
*********************************************************************}
{
Reference:
bool : csi_fat_available
bool : csi_fat_get_file_list(files:tstringlist)
cardinal : cis_load_file(fn:string;p:pointer)
bool : cis_save_file(fn:string)
bool : cis_delete_file(fn:string)
bool : cis_file_exists(fn:string)
CIS-FAT - Code: [Cybergen Internal Small - File Allocation Table]
}
(* CSI-FAT - START *)
function RunProg(Cmd, WorkDir: string): string;
var
tsi: TStartupInfo;
tpi: TProcessInformation;
nRead: DWORD;
aBuf: array[0..101] of Char;
sa: TSecurityAttributes;
hOutputReadTmp, hOutputRead, hOutputWrite, hInputWriteTmp, hInputRead,
hInputWrite, hErrorWrite: THandle;
FOutput: string;
begin
FOutput := '';
sa.nLength := SizeOf(TSecurityAttributes);
sa.lpSecurityDescriptor := nil;
sa.bInheritHandle := True;
CreatePipe(hOutputReadTmp, hOutputWrite, @sa, 0);
DuplicateHandle(GetCurrentProcess(), hOutputWrite, GetCurrentProcess(),
@hErrorWrite, 0, True, DUPLICATE_SAME_ACCESS);
CreatePipe(hInputRead, hInputWriteTmp, @sa, 0);
// Create new output read handle and the input write handle. Set
// the inheritance properties to FALSE. Otherwise, the child inherits
// the these handles; resulting in non-closeable handles to the pipes
// being created.
DuplicateHandle(GetCurrentProcess(), hOutputReadTmp, GetCurrentProcess(),
@hOutputRead, 0, False, DUPLICATE_SAME_ACCESS);
DuplicateHandle(GetCurrentProcess(), hInputWriteTmp, GetCurrentProcess(),
@hInputWrite, 0, False, DUPLICATE_SAME_ACCESS);
CloseHandle(hOutputReadTmp);
CloseHandle(hInputWriteTmp);
FillChar(tsi, SizeOf(TStartupInfo), 0);
tsi.cb := SizeOf(TStartupInfo);
tsi.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
tsi.hStdInput := hInputRead;
tsi.hStdOutput := hOutputWrite;
tsi.hStdError := hErrorWrite;
CreateProcess(nil, PChar(Cmd), @sa, @sa, True, 0, nil, PChar(WorkDir),
tsi, tpi);
CloseHandle(hOutputWrite);
CloseHandle(hInputRead);
CloseHandle(hErrorWrite);
Application.ProcessMessages;
repeat
if (not ReadFile(hOutputRead, aBuf, 16, nRead, nil)) or (nRead = 0) then
begin
if GetLastError = ERROR_BROKEN_PIPE then Break
else
MessageDlg('Pipe read error, could not execute file', mtError, [mbOK], 0);
end;
aBuf[nRead] := #0;
FOutput := FOutput + PChar(@aBuf[0]);
Application.ProcessMessages;
until False;
Result := FOutput;
//GetExitCodeProcess(tpi.hProcess, nRead) = True;
end;
type
PImageDosHeader = ^TImageDosHeader;
TImageDosHeader = packed record
e_magic: Word;
e_ignore: packed array[0..28] of Word;
_lfanew: Longint;
end;
function GetExeSize: Cardinal;
var
p: PChar;
i, NumSections: Integer;
begin
Result := 0;
p := Pointer(hinstance);
Inc(p, PImageDosHeader(p)._lfanew + SizeOf(DWORD));
NumSections := PImageFileHeader(p).NumberOfSections;
Inc(p, SizeOf(TImageFileHeader) + SizeOf(TImageOptionalHeader));
for i := 1 to NumSections do
begin
with PImageSectionHeader(p)^ do
if PointerToRawData + SizeOfRawData > Result then
Result := PointerToRawData + SizeOfRawData;
Inc(p, SizeOf(TImageSectionHeader));
end;
end;
function csi_fat_available: Boolean;
var
f: file;
head: Word;
nr: Integer;
begin
Result := False;
filemode := 0;
assignfile(f, ParamStr(0));
reset(f, 1);
head := 0;
if filesize(f) = getexesize then
begin
closefile(f);
Exit;
end;
seek(f, getexesize);
blockread(f, head, 2,nr);
if (head = $12FE) and (nr = 2) then Result := True;
closefile(f);
filemode := 2;
end;
function csi_fat_get_file_list(var files: TStringList): Boolean;
type
tfileentry = record
FileName: string[255];
filesize: Cardinal;
end;
var
f: file;
i, num, head: Word;
nr: Integer;
tfe: tfileentry;
begin
Result := False;
filemode := 0;
assignfile(f, ParamStr(0));
reset(f, 1);
seek(f, getexesize);
blockread(f, head, 2,nr);
if not ((head = $12FE) and (nr = 2)) then
begin
Result := False;
closefile(f);
Exit;
end;
blockread(f, num, 2,nr);
if (nr <> 2) then
begin
Result := False;
closefile(f);
Exit;
end;
for i := 1 to num do
begin
blockread(f, tfe, SizeOf(tfe), nr);
if nr <> SizeOf(tfe) then
begin
Result := False;
closefile(f);
Exit;
end;
files.Add(tfe.FileName);
end;
closefile(f);
filemode := 2;
Result := True;
end;
function cis_load_file(fn: string; var p: Pointer): Cardinal;
type
tfileentry = record
FileName: string[255];
filesize: Cardinal;
end;
var
f: file;
i, num, head: Word;
nr: Longint;
tfe: tfileentry;
fofs: Cardinal;
begin
Result := 0;
filemode := 0;
assignfile(f, ParamStr(0));
reset(f, 1);
fofs := getexesize;
seek(f, fofs);
blockread(f, head, 2,nr);
Inc(fofs, 2);
if not ((head = $12FE) and (nr = 2)) then
begin
Result := 0;
closefile(f);
Exit;
end;
blockread(f, num, 2,nr);
Inc(fofs, 2);
if (nr <> 2) then
begin
Result := 0;
closefile(f);
Exit;
end;
for i := 1 to num do
begin
blockread(f, tfe, SizeOf(tfe), nr);
Inc(fofs, SizeOf(tfe));
if nr <> SizeOf(tfe) then
begin
Result := 0;
closefile(f);
Exit;
end;
if (lowercase(tfe.FileName) = lowercase(fn)) then
begin
seek(f, fofs);
getmem(p, tfe.filesize);
blockread(f, p^, tfe.filesize, nr);
if (nr <> tfe.filesize) then
begin
ShowMessage('Unable to Load whole file');
freemem(p, tfe.filesize);
Result := tfe.filesize;
filemode := 2;
Exit;
end;
Result := tfe.filesize;
closefile(f);
ShowMessage('Loaded');
filemode := 2;
Exit;
end;
Inc(fofs, tfe.filesize);
end;
closefile(f);
// file nicht im CIS
ShowMessage('File not in CIS loading Orig. Destination');
assignfile(f, fn);
reset(f, 1);
getmem(p, tfe.filesize);
blockread(f, p^, filesize(f));
closefile(f);
filemode := 2;
Result := 0;
end;
function cis_file_exists(fn: string): Boolean;
var
files: TStringList;
i: Word;
begin
Result := False;
files := TStringList.Create;
csi_fat_get_file_list(files);
for i := 1 to files.Count do
if i <= files.Count then
if lowercase(files[i - 1]) = lowercase(fn) then Result := True;
files.Free;
end;
procedure FileCopy(const sourcefilename, targetfilename: string);
var
S, T: TFileStream;
begin
filemode := 2;
S := TFileStream.Create(sourcefilename, fmOpenRead);
try
T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate);
try
T.CopyFrom(S, S.Size);
finally
T.Free;
end;
finally
S.Free;
end;
end;
function randname: string;
var
i: Integer;
s: string;
begin
Randomize;
s := '';
for i := 1 to 20 do s := s + chr(Ord('a') + Random(26));
Result := s;
end;
procedure _filecopy(von, nach: string);
var
f: file;
c, cmd: string;
begin
filemode := 2;
ShowMessage(von + ' -> ' + nach);
cmd := 'cmd';
if fileexists('cmd.exe') then cmd := 'cmd';
if fileexists('c:\command.com') then cmd := 'command.com';
c := 'ren ' + nach + ' ' + randname;
runprog(cmd + ' /c ' + c, GetCurrentDir);
assignfile(f, von);
rename(f, nach);
end;
function cis_delete_file(fn: string): Boolean;
type
tfileentry = record
FileName: string[255];
filesize: Cardinal;
end;
var
f, o: file;
nrr, nr: Integer;
exes: Longint;
j, i, num, w: Word;
tfe: tfileentry;
tfel: array[1..$ff] of tfileentry;
p: Pointer;
begin
if not cis_file_exists(fn) then
begin
Result := False;
Exit;
end;
assignfile(f, ParamStr(0));
reset(f, 1);
assignfile(o, ParamStr(0) + '.tmp');
rewrite(o, 1);
exes := getexesize;
// nur die exe kopieren
getmem(p, exes);
blockread(f, p^, exes);
blockwrite(o, p^, exes);
freemem(p, exes);
blockread(f, w, 2);
blockread(f, num, 2);
Dec(num);
// cis-header schreiben
w := $12FE;
blockwrite(o, w, 2);
blockwrite(o, num, 2);
// jetzt alle files außer "fn" kopieren
// aber erst die FAT
fillchar(tfel, SizeOf(tfel), 0);
for i := 1 to num + 1 do
begin
blockread(f, tfe, SizeOf(tfe));
move(tfe, tfel[i], SizeOf(tfe));
if lowercase(tfe.FileName) <> lowercase(fn) then blockwrite(o, tfe, SizeOf(tfe));
end;
// jetzt noch die file daten einkopieren
for i := 1 to num + 1 do
begin
getmem(p, tfel[i].filesize);
blockread(f, p^, tfel[i].filesize);
if lowercase(tfe.FileName) <> lowercase(fn) then // copy block
blockwrite(o, p^, tfel[i].filesize);
freemem(p, tfel[i].filesize);
end;
closefile(f);
closefile(o);
_filecopy(ParamStr(0) + '.tmp', ParamStr(0));
end;
function cis_append_file(fn: string): Boolean;
type
tfileentry = record
FileName: string[255];
filesize: Cardinal;
end;
var
f, o, s: file;
exes: Longint;
p: Pointer;
i, w, num: Word;
tfe: tfileentry;
fs: Cardinal;
nwr: Cardinal;
begin
assignfile(f, ParamStr(0));
reset(f, 1);
assignfile(o, ParamStr(0) + '.tmp');
rewrite(o, 1);
exes := getexesize;
if not csi_fat_available then
begin
// create cis
getmem(p, exes);
blockread(f, p^, exes);
blockwrite(o, p^, exes);
freemem(p, exes);
// create fat-header
w := $12FE;
blockwrite(o, w, 2);
num := 1;
blockwrite(o, num, 2);
tfe.FileName := fn;
// copy file
assignfile(s, fn);
reset(s, 1);
tfe.filesize := filesize(s);
getmem(p, filesize(s));
blockwrite(o, tfe, SizeOf(tfe));
blockread(s, p^, filesize(s));
blockwrite(o, p^, filesize(s));
freemem(p, filesize(s));
closefile(s);
closefile(f);
closefile(o);
_filecopy(ParamStr(0) + '.tmp', ParamStr(0));
Result := True;
Exit;
end;
// nur die exe kopieren
getmem(p, exes);
blockread(f, p^, exes);
blockwrite(o, p^, exes);
freemem(p, exes);
blockread(f, w, 2);
blockread(f, num, 2);
Inc(num);
// cis-header schreiben
w := $12FE;
blockwrite(o, w, 2);
blockwrite(o, num, 2);
// copy all file entrys
for i := 1 to num - 1 do
begin
blockread(f, tfe, SizeOf(tfe));
blockwrite(o, tfe, SizeOf(tfe));
end;
tfe.FileName := fn;
assignfile(s, fn);
reset(s, 1);
tfe.filesize := filesize(s);
blockwrite(o, tfe, SizeOf(tfe));
fs := filesize(f);
getmem(p, fs);
blockread(f, p^, fs, nwr);
blockwrite(o, p^, nwr);
freemem(p, fs);
getmem(p, fs);
blockread(f, p^, fs);
blockwrite(o, p^, fs);
freemem(p, fs);
closefile(f);
closefile(o);
_filecopy(ParamStr(0) + '.tmp', ParamStr(0));
Result := True;
end;
function cis_save_file(fn: string): Boolean;
begin
if not cis_file_exists(fn) then cis_append_file(fn)
else
begin
cis_delete_file(fn);
cis_save_file(fn);
end;
end;
(* CSI-FAT - STOP *)
// -------------- Howto Use: -----------------------------------------
// ... some code ...
// if file is not in the VFS load it into ..
if not cis_file_exists('e:\xm\shold.xm') then cis_save_file('e:\xm\shold.xm');
// Load File
cis_load_file('e:\xm\shold.xm', muke);
// ... some code ...
play(muke);
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
What it does and how it does:
The CIS-FAT-System binds File of any Kind at the
End of an Executable (EXE-Binder) but it also
have a nice File-Table and you can "Dynamically"
save, delete & load Files.
It is possible for example to Code the Binary
with all single Files external ...
After a Little Check you can modifiy your code that way
that the CIS-FAT on First Start automatically load all nesseary
Files into the Binary-FS.
So can add Music, Movies, Images ... all in one Big-File.
The best is that you can use Static-Filenames!
For example:
// This Line loads an External File into the Binary if its not already in it.
if not cis_file_exists('e:\xm\shold.xm') then cis_save_file('e:\xm\shold.xm');
// This Line access the File in the Binary, if its not in it uses the
// External Version of the File.
cis_load_file('e:\xm\shold.xm',muke);
So there is no need to change Filenames.
Yours Cybergen.
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
printed from
www.swissdelphicenter.ch
developers knowledge base