Mega Code Archive
How to store a file into a component
<![CDATA[
Title: How to store a file into a component
Question: When you want to create a lite install program and dont want to use Install Shield, Wise or any other installer that makes tons of discs.
Put your files into your delphi project at design time and then just compile it to get all into one file.
You can even store waves and play it withou the need to create a file, play it from memory.
Answer:
I separated this task in two units:
1- Contains the base class for the component that store binary data (a file) and the property editor.
2- Contains the decendants with implements storing a file and storing a wave file with options to play it from memory.
First unit:
================================================
unit lStored;
interface
uses
{$IFDEF WIN32}Windows{$ELSE}WinProcs, WinTypes{$ENDIF}, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, DSGNINTF;
type
TStoredDataProperty = class(TPropertyEditor)
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure Edit; override;
end;
TStoredDataEditor = class(TComponentEditor)
function GetVerbCount: integer; override;
function GetVerb(Index: integer): string; override;
procedure ExecuteVerb(Index: integer); override;
end;
TStoredData = class(TComponent)
protected
FFilename : string;
DataHandle: THandle;
DataBuffer: Pointer;
DataSize : {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF};
DataStream: TFileStream;
procedure DefineProperties(Filer: TFiler);override;
procedure ReadData(Reader: TStream);
procedure WriteData(Writer: TStream);
procedure SetData(Filename: string); virtual;
procedure Clear;
property StoredData: string read FFilename write SetData;
public
procedure SaveToFile(NewFilename: string);
property PointerOfBuffer: Pointer read DataBuffer;
property SizeOfBuffer: {$IFDEF WIN32}Integer{$ELSE}LongInt{$ENDIF} read DataSize;
end;
implementation
{$IFNDEF WIN32}
function GetFileSize(Filename: string): LongInt;
var
F : file of byte;
begin
result:=0;
AssignFile(F, Filename);
Reset(F);
result:=FileSize(F);
CloseFile(F);
end;
{$ENDIF}
{--- Component Methods ---}
procedure TStoredData.SetData(Filename: string);
begin
if Filename='' then
begin
if DataSize0 then
begin
GlobalUnlock(DataHandle);
GlobalFree(DataHandle);
DataSize:=0;
FFilename:='';
end;
exit;
end;
if (not (csReading in ComponentState)) and (not (csLoading in ComponentState)) then
begin
if not FileExists(Filename) then
begin
MessageDlg('Invalid filename! File does not exists.',mtError,[mbOk],0);
exit;
end;
FFilename:=ExtractFileName(Filename);
if DataSize0 then
begin
GlobalUnlock(DataHandle);
GlobalFree(DataHandle);
DataSize:=0;
end;
{$IFNDEF WIN32}
DataSize:=GetFileSize(Filename);
{$ENDIF}
try
DataStream:=TFileStream.Create(Filename,fmOpenRead);
{$IFDEF WIN32}
DataSize:=GetFileSize(DataStream.Handle, @DataSize);
{$ENDIF}
DataHandle:=GlobalAlloc(GHND,DataSize);
DataBuffer:=GlobalLock(DataHandle);
DataStream.Read(DataBuffer^, DataSize);
DataStream.Free;
except
DataSize:=0;
end;
end;
end;
procedure TStoredData.SaveToFile(NewFilename: string);
begin
if DataSize0 then
begin
if NewFilename='' then
begin
with TSaveDialog.Create(Self) do
try
Title:='Save To File';
DefaultExt:='*.*';
Filter:='All Files (*.*)|*.*';
Filename:=FFilename;
Options:=[ofOverwritePrompt,ofHideReadOnly,ofPathMustExist];
if Execute then
NewFilename:=Filename;
finally
free;
end;
end;
if NewFilename'' then
with TFileStream.Create(NewFilename, fmCreate) do
try
Write(DataBuffer^, DataSize);
finally
free;
end;
end
else
MessageDlg('No data stored!',mtError,[mbOk],0);
end;
procedure TStoredData.Clear;
begin
SetData('');
end;
{--- Property Editor ---}
function TStoredDataProperty.GetAttributes: TPropertyAttributes;
begin
result:=[paDialog, paReadOnly];
end;
function TStoredDataProperty.GetValue: string;
begin
if TStoredData(GetComponent(0)).DataSize0 then
result:='(StoredData)'
else
result:='(Empty)';
end;
procedure TStoredDataProperty.Edit;
begin
with TOpenDialog.Create(TStoredData(GetComponent(0))) do
try
Title:='Open File To Store';
DefaultExt:='*.*';
Filter:='All Files (*.*)|*.*';
Filename:=TStoredData(GetComponent(0)).StoredData;
Options:=[ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofNoTestFileCreate];
if Execute then
begin
TStoredData(GetComponent(0)).SetData(Filename);
Designer.Modified;
end;
finally
free;
end;
end;
{--- Component Editor ---}
function TStoredDataEditor.GetVerbCount: integer;
begin
result:=3;
end;
function TStoredDataEditor.GetVerb(Index: integer): string;
begin
case Index of
0 : result:='Store';
1 : result:='Save To File';
2 : result:='Clear';
end;
end;
procedure TStoredDataEditor.ExecuteVerb(Index: integer);
begin
case Index of
0 : with TOpenDialog.Create(Component) do
try
Title:='Open File To Store';
DefaultExt:='*.*';
Filter:='All Files (*.*)|*.*';
Filename:=TStoredData(Component).StoredData;
Options:=[ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofNoTestFileCreate];
if Execute then
begin
TStoredData(Component).SetData(Filename);
Designer.Modified;
end;
finally
free;
end;
1 : TStoredData(Component).SaveToFile('');
2 : begin
TStoredData(Component).Clear;
Designer.Modified;
end;
end;
end;
procedure TStoredData.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineBinaryProperty('DataBuffer', ReadData, WriteData, DataSize0);
end;
procedure TStoredData.ReadData(Reader: TStream);
begin
Reader.Read(DataSize, Sizeof(DataSize));
DataHandle:=GlobalAlloc(GHND,DataSize);
DataBuffer:=GlobalLock(DataHandle);
Reader.Read(DataBuffer^, DataSize);
end;
procedure TStoredData.WriteData(Writer: TStream);
begin
Writer.Write(DataSize, Sizeof(DataSize));
Writer.Write(DataBuffer^, DataSize);
end;
end.
================================================
Second unit
================================================
unit cStored;
interface
uses lStored, Classes, SysUtils, Dialogs, WinProcs, mmSystem, DSGNINTF,
Forms;
type
TStoredFile = class(TStoredData)
published
property StoredData;
end;
{--- Property Editor for Wave Files ---}
TStoredWaveProperty = class(TPropertyEditor)
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure Edit; override;
end;
{--- Component Editor for Wave Files ---}
TStoredWaveEditor = class(TComponentEditor)
function GetVerbCount: integer; override;
function GetVerb(Index: integer): string; override;
procedure ExecuteVerb(Index: integer); override;
end;
TStoredWave = class(TStoredData)
protected
function IsWave(Filename: string): boolean;
procedure SetData(Filename: string);override;
public
procedure Play;
procedure Stop;
procedure SaveToFile(NewFilename: string);
published
property StoredWave: string read FFilename write SetData;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponentEditor(TStoredData, TStoredDataEditor);
RegisterPropertyEditor(TypeInfo(string), TStoredData, 'StoredData',TStoredDataProperty);
RegisterComponentEditor(TStoredWave, TStoredWaveEditor);
RegisterPropertyEditor(TypeInfo(string), TStoredWave, 'StoredWave',TStoredDataProperty);
RegisterComponents('Samples', [TStoredFile,TStoredWave]);
end;
{--- Component Methods ---}
procedure TStoredWave.SetData(Filename: string);
begin
if FileExists(Filename) then
if not IsWave(Filename) then
begin
MessageDlg('Invalid wave file!',mtError,[mbOk],0);
exit;
end;
inherited SetData(Filename);
end;
function TStoredWave.IsWave(Filename: string): boolean;
var
F : file;
BuffHeader: array[1..12] of char;
begin
AssignFile(F, Filename);
FileMode:=0;
Reset(F,1);
try
BlockRead(F, BuffHeader, 12);
result:=(Copy(BuffHeader, 1, 4)='RIFF') and (Copy(BuffHeader, 9, 4)='WAVE');
finally
CloseFile(F);
end;
end;
procedure TStoredWave.SaveToFile(NewFilename: string);
begin
if DataSize0 then
begin
if NewFilename='' then
begin
with TSaveDialog.Create(Self) do
try
Title:='Save To File';
DefaultExt:='*.wav';
Filter:='Wave Audio Files (*.wav)|*.wav';
Filename:=FFilename;
Options:=[ofOverwritePrompt,ofHideReadOnly,ofPathMustExist];
if Execute then
NewFilename:=Filename;
finally
free;
end;
end;
if NewFilename'' then
with TFileStream.Create(NewFilename, fmCreate) do
try
Write(DataBuffer^, DataSize);
finally
free;
end;
end
else
MessageDlg('No wave stored!',mtError,[mbOk],0);
end;
procedure TStoredWave.Play;
begin
if DataSize0 then
begin
sndPlaySound(DataBuffer, SND_MEMORY or SND_ASYNC);
end;
end;
procedure TStoredWave.Stop;
begin
sndPlaySound(nil, 0);
end;
{--- Property Editor ---}
function TStoredWaveProperty.GetAttributes: TPropertyAttributes;
begin
result:=[paDialog, paReadOnly];
end;
function TStoredWaveProperty.GetValue: string;
begin
if TStoredWave(GetComponent(0)).DataSize0 then
result:='(StoredWave)'
else
result:='(Empty)';
end;
procedure TStoredWaveProperty.Edit;
begin
with TOpenDialog.Create(TStoredWave(GetComponent(0))) do
try
Title:='Open Wave File To Store';
DefaultExt:='*.wav';
Filter:='Wave Audio Files (*.wav)|*.wav';
Filename:=TStoredWave(GetComponent(0)).StoredWave;
Options:=[ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofNoTestFileCreate];
if Execute then
begin
TStoredWave(GetComponent(0)).SetData(Filename);
Designer.Modified;
end;
finally
free;
end;
end;
{--- Component Editor ---}
function TStoredWaveEditor.GetVerbCount: integer;
begin
result:=5;
end;
function TStoredWaveEditor.GetVerb(Index: integer): string;
begin
case Index of
0 : result:='Store';
1 : result:='Save To File';
2 : result:='Clear';
3 : result:='Play';
4 : result:='Stop';
end;
end;
procedure TStoredWaveEditor.ExecuteVerb(Index: integer);
begin
case Index of
0 : with TOpenDialog.Create(Component) do
try
Title:='Open Wave File To Store';
DefaultExt:='*.wav';
Filter:='All Files (*.wav)|*.wav';
Filename:=TStoredWave(Component).StoredWave;
Options:=[ofHideReadOnly,ofPathMustExist,ofFileMustExist,ofNoTestFileCreate];
if Execute then
begin
TStoredWave(Component).SetData(Filename);
Designer.Modified;
end;
finally
free;
end;
1 : TStoredWave(Component).SaveToFile('');
2 : begin
TStoredWave(Component).Clear;
Designer.Modified;
end;
3 : TStoredWave(Component).Play;
4 : TStoredWave(Component).Stop;
end;
end;
end.
================================================
]]>