20-03-2008, 07:32 PM
بسم الله الرحمن الرحيم
ارفقت ملف مصدري Source code يحتوي على Unit متسقلة و Project مثال لعمل Export مباشرة من الــ Executable file .
بالتوفيق
ملف FileExporting.pas ---------------------
ملف MainFrm.pas --------------------------
ارفقت ملف مصدري Source code يحتوي على Unit متسقلة و Project مثال لعمل Export مباشرة من الــ Executable file .
بالتوفيق
ملف FileExporting.pas ---------------------
PHP كود :
(*
FileExporting unit for Educational use
Coded By STRELiTZIA 03/20/2008
---
You can change code and use it WITHOUT REMOVE MY NAME :)
--
your Action "OnClick Button" for exemple...
Code to Call : ExportFile('MyFile.txt', 'MyFile', 'TEXTFILE')
*)
unit FileExporting;
interface
uses
Classes, SysUtils, Forms;
procedure ExportFile(FileToExport, ResName, ResType: string);
implementation
procedure ExportFile(FileToExport, ResName, ResType: string);
var path: string;
Res: TResourceStream; (* <<-- Classes unit *)
begin
path := ExtractFilePath(* <<-- SysUtils unit *)(Application.ExeName(* <<-- Forms unit *));
Res := TResourceStream.Create(0, PChar(ResName), PChar(ResType));
Res.SaveToFile(path + FileToExport);
Res.Free;
end;
end.
ملف MainFrm.pas --------------------------
PHP كود :
unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TMain = class(TForm)
ExportBtn: TButton;
procedure ExportBtnClick(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Main: TMain;
implementation
{$R *.dfm}
(* ______________________________________________*)
{$R FileExport.res}
uses FileExporting, XpMan;
procedure TMain.ExportBtnClick(Sender: TObject);
begin
ExportFile('MyFile.txt', 'MYFILE', 'TEXTFILE');
(* Test if Sucess Exporting *)
if FileExists(ExtractFilePath(Application.ExeName) + 'MyFile.txt') then
ShowMessage('SUCESS : [File Exported Successfully]') else
ShowMessage('ERROR : [Nothing Exported]')
end;
(* ______________________________________________*)
end.