ein EXE-internes Virtual File System zur Laufzeit benutzen?

[taktaky]

Hallo,

was macht dieser Code ?

Delphi-Quellcode:

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;

Quelle ist da

Kann jemand den Code als Demo in einem Projekt einfügen. allerdings der Code ist free

ich wollte mit dem Code eine selbstkontrahiertes exe Datei erstellen

Gruß

[Luckie]

Wenn du schon den Code verlinkst, dann brauchst du hier nicht noch mal die 450 Zeilen Code zu posten. Desweiteren wäre es wohl am sinnvollesten, wenn du dichan den Autor direkt wenden würdest. Kontaktinformationen stehen im Quellcode.

[f.siebler]

steht doch am ende der Quelle:

Zitat:

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.

[shmia]

Siehe auch http://www.torry.net/vcl/compress/ot...orage1.4.1.zip (~467kb)