如何制作这样的安装文件？进来看看呀。 ( 积分: 200 )

如何制作这样的安装文件，安装后能释放所有的文件和文件夹到临时文件夹中，
并且自动运行其中某一个可执行文件呢？

1、制作.EXE 安装文件时，设置安装文件和文件夹路径到临时文件夹。
2、设置安装后自动运行。要制作.ini 文件。

{*------------------------------------------------------------------------------
文件包封装类
版权所有 (C) 2007 Ad infinitum Interface
生成数据示意图

0-------------4----------N-*-524---------------------------------M
+-------------+------------+-------------------------------------+
|--文件计数器--|-文件控制表 -|-----------------文件块 --------------|
+-------------+------------+-------------------------------------+

@Version (V 0.0.0.1) 2007-01-16
@author ruffian
-------------------------------------------------------------------------------}

unit filepack;

interface
uses Classes,Windows,SysUtils;
const
{*------------------------------------------------------------------------------
版本控制参数
-------------------------------------------------------------------------------}
MyVersion = 1;
type
{*------------------------------------------------------------------------------
通用文本信息结构[兼容动态连接库 和 C++]
-------------------------------------------------------------------------------}
__BSTR = string[255];
{*------------------------------------------------------------------------------
包裹控制块 结构
FileName: __BSTR; 文件名 长度不超过255个字符
FileSize: Int64; 文件长度 值为64Bits有符号整形
target: __BSTR; 释放目标目录名 长度不超过255个字符
action: Integer; 动作编码 值为32Bits有符号整形

-------------------------------------------------------------------------------}
TPackCB = packed record
FileName: __BSTR;
FileSize: Int64;
target: __BSTR;
action: Integer;
end;
{ TFilePack }
{*------------------------------------------------------------------------------
文件封装类根据文件信息生成流或文件
-------------------------------------------------------------------------------}

TFilePack = class(TObject)
private
{*------------------------------------------------------------------------------
@see MyVersion
-------------------------------------------------------------------------------}
version: Cardinal;
PackCBList: TMemoryStream;
PackBlock: TMemoryStream;
FileCount: Integer;
MakeFlage: Boolean;
Dir: string;
protected
function CheckBlock: Boolean;
procedure ClearNode(var Node: TPackCB);
public
constructor Create;
procedure SetDir(Thedir: string);
destructor Destroy; override;
function GetVersion: Cardinal;
function GetCount: Integer;
function GetElement(ID: Integer):TPackCB;
function AddFBC(Node: TPackCB):Integer;
procedure DelElement(ID: Integer);
procedure MakePack(FileName: string);
procedure GetPackBlock(var Destination:TMemoryStream);
function CanMakePack: Boolean;
function GetDir:string;
published

end;
implementation

function TFilePack.GetDir;
begin
Result := Dir;
end;

procedure TFilePack.ClearNode(var Node: TPackCB);
begin
Node.FileName := '';
Node.FileSize := 0;
Node.target := '';
Node.action := 0;
end;

function TFilePack.CheckBlock: Boolean;
begin
Result := False;
if PackCBList.Size = FileCount * 524 then
Result := True;
end;
{*------------------------------------------------------------------------------
检查工具是否准备好生成流或文件

@param 不需要
@return Boolean 真为准备好
-------------------------------------------------------------------------------}
function TFilePack.CanMakePack: Boolean;
begin
CheckBlock;
Result := MakeFlage;
end;
{*------------------------------------------------------------------------------
获取现在使用的版本控制参数

@return Cardinal 32-bits无符号整形量
@see MyVersion
@todo 手工将@SEE加载入HTML中并生成chm直到DelphiCodeToDOC支持
@THROWS 无抛出异常
@COMMENT 版本只1-99之间兼容
如：Version 1 与 Version 20兼容 与 Version 101 不兼容
除非在描述中 明确声明兼容某个版本[包括该版本以及此版
本之前的版本]可以兼容
如：Version 101 在其类声明 中明确表示兼容Version 20
则表示，该版本类或单元支持 Version 20[即 Version 1~20]
所用的功能能够支持
@UNKNOWN 版权所有 (C) 2007 无限界面工作室
@AUTHOR ruffian
@VERSION (V 0.0.0.1) 2007-01-16
-------------------------------------------------------------------------------}
function TFilePack.GetVersion: Cardinal;
begin
Result := version;
end;
{*------------------------------------------------------------------------------
获取已经添加的文件数

@return 文件数 32Bits有符号整形
@todo 下一个版本应将返回值类型修改为Byte兼容此版本[RELOAD]
@THROWS 无抛出异常
-------------------------------------------------------------------------------}
function TFilePack.GetCount: Integer;
begin
Result := FileCount;
end;

{*------------------------------------------------------------------------------
获取包中制定位置的元素
@param ID 32Bits有符号整形表示其指定元素的位置应为1-N的某个自然数
@COMMENT 手工修改HTML文件将 LINK加上
@return 自定义节点类型TPackCB 参见TPackCB
@todo 下一个版本应将参数类型修改为Byte兼容此版本[RELOAD]
@THROWS 无抛出异常
-------------------------------------------------------------------------------}
function TFilePack.GetElement(ID: Integer):TPackCB;
begin
ClearNode(Result);
if (ID <= FileCount)and(ID > 0)and(CheckBlock) then
begin
PackCBList.Position := (ID-1)*524;
PackCBList.Read(Result,524);
end;
end;

{*------------------------------------------------------------------------------
添加一个文件信息节点 返回 其位置信息

@COMMENT 手工修改HTML文件将 LINK加上
@param Node 自定义节点类型TPackCB 参见TPackCB
@return 32Bits有符号整形表示其指定元素的位置应为1-N的某个自然数
@todo 下一个版本应将参数类型修改为Byte兼容此版本[RELOAD]
@THROWS 无抛出异常
-------------------------------------------------------------------------------}
function TFilePack.AddFBC(Node: TPackCB): Integer;
begin
MakeFlage := False;
Result := -1;
if CheckBlock and FileExists(dir+Node.FileName) then
begin
PackCBList.Position := PackCBList.Size;
PackCBList.Write(Node,524);
FileCount := FileCount + 1;
Result := FileCount;
end;
end;

{*------------------------------------------------------------------------------
删除文件信息表中某个节点

@param ID 32Bits有符号整形表示其指定元素的位置应为1-N的某个自然数
@COMMENT
@todo 下个版本支持给出节点也能判断出某个元素并删除
@THROWS 无抛出异常
-------------------------------------------------------------------------------}
procedure TFilePack.DelElement(ID: Integer);
var
Node: TPackCB;
PCB_Pointer: Integer;
begin
MakeFlage := False;
if (ID <= FileCount)and(ID > 0)and(CheckBlock) then
begin
for PCB_Pointer := ID to FileCount - 1 do
begin
ClearNode(Node);
PackCBList.Position := PCB_Pointer*524;
PackCBList.Read(Node,524);
PackCBList.Position := PCB_Pointer*524-524;
PackCBList.Write(Node,524);
end;
PackCBList.SetSize((FileCount-1)*524);
FileCount := FileCount-1;
end;
end;

{*------------------------------------------------------------------------------
包生成指令 生成流（或者文件）
@COMMENT 其实用重载的方法就可以明确参数以判断形势
@param FileName: string 文件名
@todo 参数使用类型 __BSTR
@THROWS 无抛出异常
-------------------------------------------------------------------------------}
procedure TFilePack.MakePack(FileName: string);
var
Node: TPackCB;
PCB_Pointer: Integer;
//I: Integer;
PN_File: TMemoryStream;
begin
if CheckBlock and (FileCount <> 0) then
begin
PackBlock.Clear;
// write File Context into Block
if FileExists(FileName) then
PackBlock.LoadFromFile(FileName);
for PCB_Pointer := 1 to FileCount do
begin
ClearNode(Node);
Node := GetElement(PCB_Pointer);
PN_File := TMemoryStream.Create;
try
if FileExists(Dir+Node.FileName) then
PN_File.LoadFromFile(Dir+Node.FileName);
PN_File.Position := 0;
PackBlock.Position := PackBlock.Size;
PackBlock.CopyFrom(PN_File,0);
finally
PN_File.Free;
end;
end;
//write CtrlInfo into Block
PackCBList.Position := 0;
PackBlock.CopyFrom(PackCBList,PackCBList.Size);
//Write Count of File infomation into The Block
PackBlock.Write(FileCount,SizeOf(FileCount));
if FileName <> '' then
begin
PackBlock.SaveToFile(FileName);
end;
MakeFlage := True;
end;
end;

{*------------------------------------------------------------------------------
获取包裹的流和内存区块
@COMMENT 有好的意见请E-MAIL 给我
@param var Destination是一个内存流，
@todo 无
@THROWS 无抛出异常
-------------------------------------------------------------------------------}
procedure TFilePack.GetPackBlock(var Destination:TMemoryStream);
begin
Destination.Position := Destination.Size;
if CanMakePack and CheckBlock then
Destination.CopyFrom(PackBlock,0);
end;

{*------------------------------------------------------------------------------
构造器
@THROWS 无抛出异常
-------------------------------------------------------------------------------}
constructor TFilePack.Create;
begin
PackCBList := TMemoryStream.Create;
PackBlock := TMemoryStream.Create;
version := MyVersion;
MakeFlage := False;
Dir := '';
end;

{*------------------------------------------------------------------------------
析构器
@THROWS 无抛出异常
-------------------------------------------------------------------------------}
destructor TFilePack.Destroy;
begin
PackCBList.Free;
PackBlock.Free;
end;

procedure TFilePack.SetDir(Thedir: string);
begin
Dir := Thedir;
end;

end.


===================================================
===================================================
unit UnFilePack;

interface

uses
SysUtils,
Classes,
Windows;

const
{*------------------------------------------------------------------------------
版本控制参数
-------------------------------------------------------------------------------}
MyVersion = 1;
type
{*------------------------------------------------------------------------------
通用文本信息结构[兼容动态连接库 和 C++]
-------------------------------------------------------------------------------}
__BSTR = string[255];
{*------------------------------------------------------------------------------
包裹控制块 结构
FileName: __BSTR; 文件名 长度不超过255个字符
FileSize: Int64; 文件长度 值为64Bits有符号整形
target: __BSTR; 释放目标目录名 长度不超过255个字符
action: Integer; 动作编码 值为32Bits有符号整形

-------------------------------------------------------------------------------}
TPackCB = packed record
FileName: __BSTR;
FileSize: Int64;
target: __BSTR;
action: Integer;
end;

{ TUnFilePack }

TUnFilePack = class(TObject)
private
version: Cardinal;
PackCBList: TMemoryStream;
PackBlock: TMemoryStream;
FFileCount: Integer;
FBlockName: string;
FLog: TStringList;
FDeBug: Boolean;
protected
procedure SetBlock(BlockName: String);
procedure AnalyzeBlock;
procedure SetFileCount(Num: Integer);
procedure SetPackCBL(PCBL:TMemoryStream);
procedure ReleaseFile(BlockIndex: Integer);
function Orientation(BlockIndex: Integer):Int64;
function FileBlockInfo(BlockIndex: Integer):TPackCB;
procedure TranslateOwnerStr(var Str:string);overload;
procedure TranslateOwnerStr({var }style: Byte;var Str:string);overload;
procedure SetLog(Str: string);
procedure SetDebug(Switch: Boolean);
procedure ClearNode(var Node: TPackCB);
public
constructor Create;overload;
constructor Create(BN: string);overload;
destructor Destroy; override;
procedure UnPack;
published
property Count: Integer read FFileCount;
property Log: TStringList read FLog;
property Block: string read FBlockName write SetBlock;
property DeBug: Boolean read FDeBug write SetDeBug;
end;


implementation

procedure TUnFilePack.UnPack;
var
i: Integer;
begin
if FFileCount > 0 then
begin
for i := 1 to FFileCount do
begin
ReleaseFile(i);
end;
end;
end;

function TUnFilePack.Orientation(BlockIndex: Integer):Int64;
var
i: Integer;
VNode: TPackCB;
begin
Result := 4 + 524*FFileCount;
for i := 1 to BlockIndex do
begin
VNode := FileBlockInfo(i);
Result := Result + VNode.FileSize;
SetLog('Orientation in the Block for '+ VNode.FileName +'.');
end;
end;

procedure TUnFilePack.ClearNode(var Node: TPackCB);
begin
Node.FileName := '';
Node.FileSize := 0;
Node.target := '';
Node.action := 0;
end;

function TUnFilePack.FileBlockInfo(BlockIndex: Integer):TPackCB;
var
PackPot: Int64;
begin
ClearNode(Result);
if BlockIndex*524 <= PackCBList.Size then
begin
PackPot := PackCBList.Position;
PackCBList.Position := BlockIndex*524-524;
PackCBList.Read(Result,524);
PackCBList.Position := PackPot;
SetLog('Succeed Get BlockInfonation.');
end
else
begin
SetLog('Get File Block Infomation failed -- Index overflow.');
end;
end;

constructor TUnFilePack.Create;
begin
FLog := TStringList.Create;
PackCBList := TMemoryStream.Create;
PackBlock := TMemoryStream.Create;
version := MyVersion;
FFileCount := 0;
FBlockName := '';
FDeBug := False;
end;

constructor TUnFilePack.Create(BN: string);
begin
Create;
SetBlock(BN);
SetLog('Block File Load from '+BN+'.');
end;

destructor TUnFilePack.Destroy;
begin
PackCBList.Free;
PackBlock.Free;
if FDeBug then
FLog.SaveToFile(ExtractFileDir(FBlockName)+FormatDateTime('yyyy-mm-dd-hhmmss',Now)+'.log');
FLog.Free;
end;

procedure TUnFilePack.SetBlock(BlockName: String);
begin
if FileExists(BlockName) then
begin
PackBlock.Clear;
PackBlock.LoadFromFile(BlockName);
FBlockName := BlockName;
SetLog('BlockName changed:'+BlockName+'.');
AnalyzeBlock;
end;
end;

procedure TUnFilePack.SetLog(str: string);
begin
FLog.Add(FormatDateTime('[yyyy-mm-dd tttt] ',Now)+str);
end;

procedure TUnFilePack.SetDebug(Switch: Boolean);
begin
FDeBug := Switch;
if FDeBug then
begin
SetLog('Debug ON,Destroy Class you can get Log file.');
end
else
begin
SetLog('Debug OFF.');
end;
end;

procedure TUnFilePack.SetFileCount(Num: Integer);
begin
FFileCount := Num;
SetLog('FileCount be set.');
end;

procedure TUnFilePack.AnalyzeBlock;
var
TheCount, i: Integer;
TheCBL: TMemoryStream;
TheTotalSize: Int64;
Sw_Node: TPackCB;
begin
if FBlockName <> '' then
begin
TheCount := 0;
TheTotalSize := 0;
TheCBL := TMemoryStream.Create;
PackBlock.Position := PackBlock.Size - 4;
PackBlock.Read(TheCount,4);
TheCBL.Clear;
TheCBL.Position := 0;
for i := 1 to TheCount do
begin
PackBlock.Position := PackBlock.Size - 4 - (524*i);
PackBlock.Read(Sw_Node,524);
TheCBL.Write(Sw_Node,524);
TheTotalSize := TheTotalSize + Sw_Node.FileSize;
end;
TheTotalSize := TheTotalSize + TheCount*524 + 4;
if TheTotalSize <= PackBlock.Size then
begin
SetFileCount(TheCount);
SetPackCBL(TheCBL);
SetLog('Analyze succeed.');
end
else
begin
SetLog('AnalyzeBlock failed -- Checkout Block is Bad:');
SetLog(' File Count id :'+ IntToStr(TheCount));
SetLog(' Block Check Size:'+ IntToStr(TheTotalSize));
end;
TheCBL.Free;
end
else
begin
SetLog('AnalyzeBlock failed -- Checkout Block not exist.');
end;
end;

procedure TUnFilePack.SetPackCBL(PCBL:TMemoryStream);
begin
PackCBList.Clear;
PCBL.Position := 0;
PackCBList.CopyFrom(PCBL,PCBL.Size);
SetLog('Crtl_Block be set.');
end;

procedure TUnFilePack.TranslateOwnerStr(var Str:string);
var
TempStr,tmp: string;

function GetSysDir:String;
var
pchar;
begin
GetMem(P,255);
GetSystemDirectory(p,254);
Result := p;
Freemem(p);
end;

function GetWinDir:String;
var
pchar;
begin
GetMem(P,255);
GetWindowsDirectory(p,254);
Result := p;
Freemem(p);
end;

function GetUsr:String;
var
pchar;
i:Cardinal;
begin
GetMem(P,255);
i:=254;
GetUserName(p,i);
Result := p;
Freemem(p);
end;

function GetHost:String;
var
pchar;
i:Cardinal;
begin
GetMem(P,255);
i:=254;
GetComputerName(p,i);
Result := p;
Freemem(p);
end;

begin
TempStr := Copy(Str,4,Length(Str)-3);
tmp := UpperCase(Copy(Str,1,3));
if tmp = 'SYS' then
Str := GetSysDir+TempStr
else if tmp = 'WIN'then
Str := GetWinDir+TempStr
else if tmp = 'USR'then
Str := GetUsr
else if tmp = 'HOS'then
Str := GetHost
else if tmp = 'CUR'then
Str := GetCurrentDir;
SetLog('Translate string:'+ Str + '.');
end;

procedure TUnFilePack.TranslateOwnerStr({var }style: Byte;var Str:string);
begin
if style = 0 then
begin
Str := '';
end
else if style = 1 then
begin
//style := 255;
Str := 'Regedit /s ';
end
else if style = 2 then
begin
//style := 255;
Str := 'start /wait ';
end
else if style = 3 then
begin
//style := 255;
Str := 'start ';
end;
SetLog('Translate Command:'+ Str + '.');
// sss 88569539
end;

procedure TunFilePack.ReleaseFile(BlockIndex: Integer);
var
Node: TPackCB;
Aim: TFileStream;
UFPA: string;
begin
Node := FileBlockInfo(BlockIndex);
UFPA := Node.target;
TranslateOwnerStr(UFPA);
Aim := TFileStream.Create(UFPA+Node.FileName,fmCreate or fmOpenReadWrite);
try
//Aim.LoadFromFile(UFPA+Node.FileName);
PackBlock.Position :=PackBlock.Size - Orientation(BlockIndex);
Aim.CopyFrom(PackBlock,Node.FileSize);
SetLog('Release File'+Node.target+Node.FileName+'.');
finally
Aim.Free;
end;
UFPA := '';
TranslateOwnerStr(Byte(Node.action),UFPA);
if UFPA <> '' then
WinExec(PChar(UFPA+Node.FileName),SW_HIDE);
end;

end.

program Install;

{$APPTYPE CONSOLE}

uses
SysUtils,
System,
Classes,
Registry,
Windows,
UnFilePack in 'UnFilePack.pas';
procedure DelFile(FileName:string);
var
Ofile : file;
begin
try
AssignFile(Ofile,FileName);
Erase(Ofile);
finally

end;
end;
type
TIPAdd = string[20];


var
ServIP: TIPAdd;
PackStream: TMemoryStream;
Version: Byte;
PackName: string;
UPack: TUnFilePack;
RegIt: TRegistry;
begin
if ParamCount < 1 then
begin
PackName := ParamStr(0);
end
else
begin
if FileExists(ParamStr(1)) then
PackName := ParamStr(1)
else
PackName := ParamStr(0);
end;
if FileExists(PackName) then
begin
PackStream := TMemoryStream.Create;
PackStream.LoadFromFile(PackName);
PackStream.Position := PackStream.Size - SizeOf(Version);
PackStream.Read(Version,SizeOf(Version));
if Version <= 1 then
begin
ServIP := '';
PackStream.Position := PackStream.Size - SizeOf(Version) - SizeOf(ServIP);
PackStream.Read(ServIP,SizeOf(ServIP));
PackStream.Position := 0;
PackStream.SetSize(PackStream.Size - SizeOf(Version) - SizeOf(ServIP));
PackStream.SaveToFile('c:/dasdwejkauwbkahdj.dat');
UPack := TUnFilePack.Create;
UPack.Block := 'c:/dasdwejkauwbkahdj.dat';
UPack.DeBug := True;
if UpperCase(ParamStr(ParamCount)) = 'DEBUG' then
UPack.DeBug := True;
UPack.UnPack;
UPack.Free;
DelFile('c:/dasdwejkauwbkahdj.dat');
//固定的注册表操作
end
else
begin
Writeln('Version Too low can not analyze Pack,Download New Analyze to use');
end;
PackStream.Free;
end;
{ TODO -oUser -cConsole Main : Insert code here }
end.

第一次这样写东西，挺别扭的！不过肯定可以用
打包的过：
program Pack;

{$APPTYPE CONSOLE}

uses
SysUtils,
System,
Classes,
filepack in 'filepack.pas';
type
TIPAdd = string[20];

function IsIPAdd(IP: string):Boolean;
var
i,DotCount,tmpi: Integer;
tmp: string;
OB: Boolean;
begin
Result := True;
if (Length(IP) > 15) and (Length(IP) < 6) then
begin
Result := False;
Exit;
end;
OB := False;
DotCount := 0;
tmp := '';
for i := 1 to Length(IP) do
begin
if IP = '.' then
begin
OB := True;
DotCount := DotCount + 1;
end;

if not OB then
if IP in ['0'..'9'] then
tmp := tmp + IP
else
begin
Result := False;
Exit;
end;
if i = Length(IP) then
begin
OB := True;
DotCount := 4;
end;
if OB then
begin
tmpi := StrToInt(tmp);
case DotCount of
1:if (tmpi < 1) or (tmpi > 223) then Result := False;
2..3:if (tmpi < 0) or (tmpi > 255) then Result := False;
4:if (tmpi < 1) or (tmpi > 254) then Result := False;
end;
if not Result then Exit;
tmp := '';
OB := False;
end;
end;
end;

function IsMun(Str: string):Boolean;
var
i: Integer;
begin
Result := True;
for i := 1 to Length(Str) do
if not (Str in ['0'..'9']) then
begin
Result := False;
Break;
end;
end;

procedure DisplayHelp;
begin
Writeln('Command List:');
Writeln('-------------------------------------------------------------------');
Writeln(' Add -- Add a node into pack.');
Writeln(' Del -- del a node in the pack.');
Writeln(' Sip -- Set Server IP add for Install pack.');
Writeln(' See -- see a node into pack.');
Writeln(' End -- end statement make pack.');
Writeln;

end;

procedure addnode(var Node:TPackCB;dir: string);
var
f: file of Byte;
tmp: string;
label SetMode;
begin
Writeln('Add Node:');
Writeln('-------------------------------------------------------------------');
Node.FileName := '';
Node.FileSize := 0;
Node.target := '';
Node.action := 0;
Write(' FileName:');
readln(Node.filename);

if FileExists(dir+Node.FileName) then
begin
AssignFile(f, dir+Node.FileName);
Reset(f);
Node.FileSize := Int64(FileSize(f));
CloseFile(f);
Writeln(' File Size:'+IntToStr(Node.FileSize));
Writeln(' Set Release Target:');
Writeln(' SYS -- %system%');
Writeln(' WIN -- %windows%');
Writeln(' CUR -- directory where you application run');
Writeln(' ** you must end this with "/"');
Writeln(' ** Exp: "SYS/" or "WIN/system32/drivers/"');
Write(' Target:');
Readln(Node.target);
SetMode:
Writeln(' Set Run Mode:');
Writeln(' 0 Ignore; 1 Import *.Reg file; 2 Run it untill over;');
Writeln(' 3 Just Run It.');
Write(' Mode:');
Readln(tmp);
if (Length(tmp)>1) and not(tmp[1] in ['0'..'3']) then goto SetMode;
Node.action := StrToInt(tmp);
end
else
begin
Writeln(' error: File not exists.');
end;
end;

procedure ShowNode(Node: TPackCB);
begin
Writeln('-------------------------------------------------------------------');
Writeln(' FileName -- '+Node.FileName);
Writeln(' FileSize -- '+IntToStr(Node.FileSize));
Writeln(' Target -- '+Node.target);
Write(' action -- ');
case Node.action of
0:Writeln('Ignore');
1:Writeln('Import *.Reg file');
2:Writeln('Run it untill over');
3:Writeln('Just Run It');
end;
Writeln('-------------------------------------------------------------------');
end;

var
PackBlock: TFilePack;
Node: TPackCB;
CommandStr: string;
loopcrtl: Boolean;
SIP,ml: string;
I: Integer;
ServIP: TIPAdd;
PackStream: TMemoryStream;
Version: Byte;
FileS:TMemoryStream;
label SeeLoca,DelLoca;
begin
loopcrtl := True;
PackBlock := TFilePack.Create;
writeln('Ad infinitum Interface Studio Tools -- Pack V 0.0.01');
Writeln('');
Write(' Setup directory:');
Readln(CommandStr);
PackBlock.SetDir(CommandStr);
Writeln;
while loopcrtl do
begin
DisplayHelp;
Readln(CommandStr);
if UpperCase(CommandStr) = 'ADD' then
begin
addnode(Node,PackBlock.GetDir);
PackBlock.AddFBC(Node);
end;
if UpperCase(CommandStr) = 'SEE' then
begin
Seeloca:
Write(' Total '+IntToStr(PackBlock.GetCount)+' Select :');
Readln(ml);
if (StrToInt(ml) > PackBlock.GetCount) or not IsMun(ml) then
begin
Writeln('Bad Input!');
goto SeeLoca;
end;
i := StrToInt(ml);
Node := PackBlock.GetElement(i);
ShowNode(Node);
end;
if UpperCase(CommandStr) = 'DEL' then
begin
Delloca:
Write(' Total '+IntToStr(PackBlock.GetCount)+' Select :');
Readln(ml);
if (StrToInt(ml) > PackBlock.GetCount) or not IsMun(ml) then
begin
Writeln('Bad Input!');
goto DelLoca;
end;
i := StrToInt(ml);
Node := PackBlock.GetElement(i);
ShowNode(Node);
Write(' Delete this Node?(Y/N):');
Readln(ml);
if (UpperCase(ml) = 'Y') or (UpperCase(ml) = 'YES') then
PackBlock.DelElement(i);
end;
if UpperCase(CommandStr) = 'SIP' then
begin
Write(' InPut Server IP Address:');
Readln(SIP);
if IsIPAdd(SIP) then
begin
ServIP := SIP;
end
else
begin
Writeln(' Bad IP Address!!!');
end;
end;
if UpperCase(CommandStr) = 'END' then
begin

loopcrtl := False;
Write(' Input PackFile Full Name:');
Readln(ml);
PackStream := TMemoryStream.Create;
PackStream.Clear;

if FileExists(ml) then
begin
PackStream.Position := 0;
FileS := TMemoryStream.Create;
FileS.LoadFromFile(ml);
FileS.Position := 0;
PackStream.Position := PackStream.Size;
PackStream.CopyFrom(FileS,0);
FileS.Free;
end;

PackBlock.MakePack('');
PackBlock.GetPackBlock(PackStream);

Version := 1;
PackStream.Position := PackStream.Size;
PackStream.Write(ServIP,SizeOf(ServIP));
PackStream.Position := PackStream.Size;
PackStream.Write(Version,SizeOf(Version));
Write(' Output PackFile Full Name:');
ml := '';
Readln(ml);
PackStream.SaveToFile(ml);
PackStream.Free;


end;
end;
PackBlock.Destroy;
{ TODO -oUser -cConsole Main : Insert code here }
end.

基本思想就是把数据附在程序的后面

解包程序读取展开就OK了

缺陷：破坏了PE结构，数据没有在PE中进行描述（单从构建包，和解析包的功能上是行得通的）；坏的数据结构，不紧凑也不高效，使用大量的stream操作稳定性上还有待研究

扩展：可以把命令操作也用同样的方法加入。这样就能执行比较智能的行为了

Ad infinitum Interface
声明：以上代码以DELPHI7为基础开发 在DELPHI2006下编译通过没有进行测试
以上代码执行GPL协议 如果引用清注明版权信息

我是这个意思：
我做个我的软件的打包程序。install.exe
还要做个msde数据库的安装程序。
把这些东西合在一起。
再做个安装的程序（setup.exe）。这个安装的程序界面上只有一个图片。
上面有二个按钮。
按钮1：msde数据库安装。
按钮2:本软件的安装 执行install.exe
把上面的setup.exe msde 和install这些全部压缩到一起合成为一个安装文件（A）。
用户点击最终的这个安装文件（A）安装后，就能自动解压 。并且
运行setup.exe。
应该用什么软件可以实现这个功能的吧。



我就想用个现成的软件。

就用winrar自解压即可。

接受答案了.