如何加入Res資源檔(讓你可以將bmp、txt、dll、jpg檔...跟exe檔包在一起)

首先要有資源檔製作工具，裡面包括有：
_BuildRes.bat
Build.ini
Build.rc
ZPack.exe
及你要包的檔案(在此我是加入Wording0.txt及Wording1.txt多國語言版)

然後先編輯Build.ini，其內容如下：

[System]
Extention=.Tmp

;程式所要使用到的檔案列表，這些檔案會被ZPack包成.Tmp檔。
[Files]
0=Wording0.txt
1=Wording1.txt

然後執行
_BuildRes.bat
就會產生Build.RES及BUILD.Tmp。

這時將Build.RES複製到你主程式的目錄內。

在主程式{$R *.dfm}的後面加上下面這一行：

{$R build.res}

並加入UZPack.pas及URandomString到你的專案內：
其程式碼如下：

unit UZPack;

interface

uses
  Windows, Classes, SysUtils, {FileCtrl,} ZLib, Forms, URandomString;

function ExtractDLL(APath, ASrcFilename: String; ARenameFile: Boolean): String;
//function ExtractDLL2(APath, ASrcFilename: String; ARenameFile: Boolean): String;

implementation

//uses ULogFileOut ;

//==========================================================================
function MyUpcase(S:string):string;
var L,D:Integer;
    P,Q:PChar;
    C:char;
begin
  L:=Length(S);             P:=@S[1];
  while L>0 do begin
    Q:=CharNext(P);         D:=Q-P;
    if D=1 then begin
      C:=P^;
      if (C>='a') and (C<='z') then P^:=char(byte(C) and $DF);
    end;
    dec(L,D);     P:=Q;
  end;
  Result:=S;
end;

//==========================================================================
function FindName(F:string; G:TStream):string;
var Sz:DWord;
  L:byte;
  Fn:array[0..255] of char;
begin
 Result:='';
 F:=MyUpCase(F);
  while G.Position < G.Size do begin                     // Search file name
    G.Read(L,Sizeof(L));     G.Read(Fn,L);       Result:=StrPas(Fn);
    if (F=StrPas(Fn)) or (F='') then break;            // Find
    G.Seek(4,1);                                       // Skip
    G.Read(Sz,Sizeof(Sz));   G.Seek(Sz,1);
    Result:='';
  end;
end;

//==========================================================================
function LoadZip(Tag,Zip:TStream):DWord;
var Z:TDecompressionStream;
    L:DWord;
begin
  Tag.Size:=0;
  Zip.Read(L,Sizeof(L));
 Zip.Read(Result,Sizeof(Result));
  Z:=TDecompressionStream.Create(Zip);
  Tag.CopyFrom(Z,L);
  Tag.Seek(0,0);
  Z.Free;
end;

//==========================================================================
function Unpack(P,FileName:string; ChangeName:Boolean):TStringList;
var T:TStream;
    s,
    G,N:string;
    X:TStream;
begin
  Result:=TStringList.Create;
  try
 P:=MyUpCase(P);           ForceDirectories(P);
    T:=TResourceStream.Create(HInstance,'ZIPDATA','FINEART');
    if Assigned(T) then begin
      repeat
        N:=FindName(FileName,T);
        if N<>'' then begin
          if ChangeName then
          begin
            s := RandomAlphabetString(0, 8, True);
            G:=Format('%s%s%s',[P,s,ExtractFileExt(N)]);
          end
          else
            G:=P+N;
          X:=TFileStream.Create(G,fmCreate);
          if Assigned(X) then begin
            LoadZip(X,T);
            Result.AddObject(Format('%s=%s',[N,G]),TObject(X.Size));
            X.Free;
          end;
        end;
      until N='';
      T.Free;
    end;
  except
  end;
end;

{==============================================================================}
{   函式敘述：                                                                 }
{       將以ZPack包在程式Resource中的檔案解出來到特定目錄。                    }
{   參數：                                                                     }
{       APAth:                                                                 }
{           要解到哪個目錄。                                                   }
{       ASrcFilename:                                                          }
{           要解出哪個檔案。                                                   }
{       ARenameFile:                                                           }
{           解出來的檔案是否要換成隨機的檔名。                                 }
{   傳回值：                                                                   }
{       若成功解出，會傳回該檔案的完整路徑檔名。否則傳回空字串。               }
{==============================================================================}
function ExtractDLL(APath, ASrcFilename: String; ARenameFile: Boolean): String;
var
  L:    TStringList;
begin
  Result := ExtractFilePath(Application.ExeName) + ASrcFilename;
  L := Unpack(APath, ASrcFilename, ARenameFile);
  if L.Count > 0 then
  begin
    Result := L[0];
 Result := Copy(Result, AnsiPos('=', Result) + 1, Length(Result));
  end;
  L.Free;
  if not FileExists(Result) then
    Result := '';
end;

{
function ExtractDLL2(APath, ASrcFilename: String; ARenameFile: Boolean): String;
var
  L:    TStringList;
begin
  Result := APath + ASrcFilename;
  L := Unpack(APath, ASrcFilename, ARenameFile);
DDLOG('Unpack pathname :' + Result ) ;
  if L.Count > 0 then
  begin
    Result := L[0];
   Result := Copy(Result, AnsiPos('=', Result) + 1, Length(Result));
DDLOG('L.Count>0: ' + Result ) ;
  end;
  L.Free;
  if not FileExists(Result) then
    Result := '';
end;
}
end.

unit URandomString;

interface

function RandomAlphabetChar(Caps: Byte=0): Char;
function RandomAlphabetString(Caps: Byte=0; ALength: Integer=0;
                              WantNum: Boolean=false): String;

implementation

(*======================================================
               隨機取一個英文字母
            Parameter:
                Caps:   是否限制大小寫
                    0 : 不限
                    1 : 大寫字母
                    2 : 小寫字母
            Return:
                傳回亂數取得的英文字母
*)
function RandomAlphabetChar(Caps: Byte=0): Char;
begin
  Result:=Chr($61+Random(26));
  Case Caps of
    0:
      begin
        // 隨機決定大小寫
        if Random(2)=1 then
          Result:=UpCase(Result);
      end;
    1:
      Result:=UpCase(Result);
  end;
end;

(*======================================================
               隨機產生一個字串
            Parameter:
                Caps:   是否限制大小寫
                    0 :     不限
                    1 :     大寫字母
                    2 :     小寫字母
                Length: 字串長度，若為0則長度為1~10的不定長度值
                WantNum:是否要夾雜有數字
                    true : 要夾雜數字
                    false: 不要有數字
            Return:
                傳回隨機產生的字串
*)
function RandomAlphabetString(Caps: Byte=0; ALength: Integer=0;
                              WantNum: Boolean=false): String;
var
  i:    Integer;
  iLen: Integer;
begin
  // 要產生的字串長度
  if ALength=0 then
    iLen:=Random(10)+1
  else
    iLen:=ALength;

  Result:='';
  for i:=0 to iLen-1 do
  begin
    if WantNum then
      if Random(2)=1 then
      begin
        Result:=Result+Chr(Random(10)+$30);
        continue;
      end;
    Result:=Result+RandomAlphabetChar(Caps);
  end;
end;

end.

皆接在讀取文字檔的ULang.pas內，先按ALT+F11加入uses UZPack。
並判斷如果目錄下沒有多國語言文字檔的話，則讀取資源檔，程式碼如下：

//初始化字串檔(解檔及取得檔名) by v
function InitStringFile():boolean;
var
  sStringFileName:string;
begin
  //result:=false;
  g_cLang := GetLanguage;// 取得系統語系
  //g_cLang := '1';//
  if not (g_cLang in ['0','1','2','3']) then
    g_cLang := '2' ;// 目前只提供四種語言，內訂英文

  sStringFileName:='wording' + g_cLang + '.txt' ;
  g_sStrFile:=g_sWorkPath +sStringFileName;
  //showmessage(g_sStrFile);

  //檢查目前執行環境同目錄下,若無字串檔,則解檔案至 temp 路徑下
  if not FileExists(g_sStrFile) then
  begin
    g_sStrFile:=g_sTempPath+sStringFileName;
    if( StrIComp(PChar(ExtractDLL(g_sTempPath, sStringFileName, false)),PChar(g_sStrFile)) <> 0 ) then    // 解壓縮文字檔
    begin
      result:=False;
      //showmessage('Extract wording file failed !');
      exit;
    end ;
  end;

  result:=true;
end;

另外想解壓縮mdb放到temp目錄下，又不想刪除，可用下列的方式
新增UCommon.pas

unit UCommon;

interface

uses Windows, SysUtils;

procedure InitGlobalVariable;
function GetWorkDirectory:String;
function GetTmpDirectory(): string ;
function ExtractZpackFile(filename:String):String;

var
  g_sTempPath   : string;   // (TempPath)
  g_sWorkPath   : string;   // (WorkingPath)

implementation

uses UZPack;

procedure InitGlobalVariable;
begin
  g_sWorkPath:=GetWorkDirectory();
  g_sTempPath:=GetTmpDirectory();
  createdir(g_sTempPath+'QooFunds');  //在%temp%\下建立QooFunds資料夾
  g_sTempPath:=g_sTempPath + 'QooFunds\';
end;

function GetWorkDirectory;
var
  aBuf:     array[0..260] of Char;
begin
  GetModuleFileName(HINSTANCE, @aBuf[0], SizeOf(aBuf));
  Result := IncludeTrailingBackslash(ExtractFilePath(StrPas(aBuf)));
end;

function GetTmpDirectory(): string ;
var
  dwBuffSize : DWORD ;
  cBuffer : array[0..MAX_PATH] of char ;
begin
  dwBuffSize := MAX_PATH ;
  GetTempPath( dwBuffSize, cBuffer) ;
  Result := cBuffer ;
end ;

function ExtractZpackFile(filename:String):String;
var
  sPathName : string ;
begin
  sPathName := g_sTempPath + filename ;
  if not FileExists(sPathName) then
    if( StrIComp(PChar(ExtractDLL(g_sTempPath, filename, false)),PChar(sPathName)) <>0  ) then
    begin
    // ErrMsgBox('Extract report templete failed') ;
      Halt ;
    end ;
  Result:= sPathName;
end;

end.

project1

program Project1;

uses
  ExceptionLog,
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  UZPack in 'UZPack.pas',
  URandomString in 'URandomString.pas',
  UCommon in 'UCommon.pas';

{$R *.res}
{$R build.res}

begin
  InitGlobalVariable;

  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

主視窗開始加入

uses UZPack, UCommon;

procedure TForm1.FormCreate(Sender: TObject);
begin
  sTemplateFile:=ExtractZpackFile('我的基金.mdb');

  ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='+sTemplateFile+';Mode=Share Deny None;Persist Security Info=False;Jet OLEDB:Engine Type=5';
  try
    ADOConnection1.Connected    := True;
  except
    Showmessage('連線失敗!');
  end;
end;