Delphi Source Code
Search engine
HOME Components Tutorials Add Trick Links Contacts
ActiveX Components Database Files Forms Graphic Internet/Lan Math Miscellaneous Multimedia Printing Strings System Information Windows

Delphi source code for Files >> Use an Exe Internal Virtual File System @ RunTime


Category: Files
Title: Use an Exe Internal Virtual File System @ RunTime
Author: Cybergen
E-mail: nope2k@web.de
Date added: 15.03.2006
Hits: 15584


{*********************************************************************
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);
  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;
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);
  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;
  getmem(p, exes);
  blockread(f, p^, exes);
  blockwrite(o, p^, exes);
  freemem(p, exes);
  blockread(f, w, 2);
  blockread(f, num, 2);
  Dec(num);
  w := $12FE;
  blockwrite(o, w, 2);
  blockwrite(o, num, 2);
  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;
  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
    getmem(p, exes);
    blockread(f, p^, exes);
    blockwrite(o, p^, exes);
    freemem(p, exes);
    w := $12FE;
    blockwrite(o, w, 2);
    num := 1;
    blockwrite(o, num, 2);
    tfe.FileName := fn;
    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;
  getmem(p, exes);
  blockread(f, p^, exes);
  blockwrite(o, p^, exes);
  freemem(p, exes);
  blockread(f, w, 2);
  blockread(f, num, 2);
  Inc(num);
  w := $12FE;
  blockwrite(o, w, 2);
  blockwrite(o, num, 2);
  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 *)
if not cis_file_exists('e:\xm\shold.xm') then  cis_save_file('e:\xm\shold.xm');
cis_load_file('e:\xm\shold.xm', muke);
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:
if not cis_file_exists('e:\xm\shold.xm') then cis_save_file('e:\xm\shold.xm');
cis_load_file('e:\xm\shold.xm',muke);
So there is no need to change Filenames.
Yours Cybergen.
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}


Related Delphi Source Code:
Delphi Tricks
Delphi Tricks
For any problems or recommendations about Delphi Tricks site, please

feel free to contact us on that e-mail: support@delphitricks.com.
If you want to advertise on the site use that e-mail: advertise@delphitricks.com.

You can freely use or modify these Delphi source codes for non-commercial use. We are not responsible of any damages that can be caused by the utilisation of that source codes.

Copyright © 2006-2010 AVSoftware Company. All rights reserved.
Hide IP tricks