Tips (1541)

Tip Bewertung (19):

{*********************************************************************
 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.
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}