AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi ein EXE-internes Virtual File System zur Laufzeit benutzen?
Thema durchsuchen
Ansicht
Themen-Optionen

ein EXE-internes Virtual File System zur Laufzeit benutzen?

Ein Thema von taktaky · begonnen am 15. Aug 2007 · letzter Beitrag vom 15. Aug 2007
 
taktaky
(Gast)

n/a Beiträge
 
#1

ein EXE-internes Virtual File System zur Laufzeit benutzen?

  Alt 15. Aug 2007, 10:47
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ß
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 17:15 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz