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;