neoturk: ...Load rft text from a resource file into a trichedit ?...
(*
Load RTF file from resource:
You can store any kind of file as a RCDATA resource.
The following example shows this with an RTF file.
Create a text file called textres.rc and put the
following line in it:
TESTDOC RCDATA "textdoc.rtf"
Next, compile that using the Borland Resource Compiler,
which is provided with Delphi.
brcc32.exe textres.rc
Your next step is to include the compiled resource (.RES) file into
your executable, which can be done with the {$R} compiler directive.
*)
(*
Man kann eine beliebige Datei als RCDATA Ressource in eine
Exe-Datei einbinden.
Das folgende Beispiel zeigt, wie man einen RTF-Text aus
einer Ressource lädt und in einem TRichEdit anzeigt.
Erstelle zuerst eine Datei "textres.rc" mit folgendem Inhalt:
TESTDOC RCDATA "textdoc.rtf"
Kompiliere diese mit brcc32.exe:
brcc32.exe textres.rc
Es wurde nun eine textres.res Datei erzeugt.
*)
implementation
{$R *.dfm}
{$R textres.res} // <---- your resource file!
procedure TForm1.Button1Click(Sender: TObject);
var
rs: TResourceStream;
begin
rs := TResourceStream.Create(hinstance, 'TESTDOC', RT_RCDATA);
try
Richedit1.PlainText := False;
TempStream.Position := 0;
Richedit1.Lines.LoadFromStream(rs);
finally
rs.Free;
end;
end;
Delphi - .....................................
neoturk: ...Set a file's compression state ?...
{
To set a file's compression state, use the DeviceIoControl function with the
FSCTL_SET_COMPRESSION operation.
Call the following function with the name of the file to compress and
boolean parameter 'forceCompress'. If that one is true, file will be compressed.
If it is false, the file will be compressed only if its parent folder is
compressed (reason for that parameter: if you MoveFile uncompressed file from
uncompressed folder to compressed folder, file will not become automatically
compressed - at least under some NT 4 service packs).
Ein "compressed" Attribut kann man nicht mit der FileSetAttr Funktion setzen
sondern muss DeviceIoControl Funktion mit dem flag FSCTL_SET_COMPRESSION verwenden:
}
const
COMPRESSION_FORMAT_NONE = 0
COMPRESSION_FORMAT_LZNT1 = 2
COMPRESSION_FORMAT_DEFAULT = 1;
FILE_DEVICE_FILE_SYSTEM = 9;
METHOD_BUFFERED = 0;
FILE_READ_DATA = 1;
FILE_WRITE_DATA = 2;
FSCTL_SET_COMPRESSION = (FILE_DEVICE_FILE_SYSTEM shl 16) or
((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or (16 shl 2) or METHOD_BUFFERED;
function SetCompressedAttribut(FileName: PChar; forceCompress: Boolean): Boolean;
var
hnd: Integer;
Comp: SHORT;
res: DWORD;
begin
if forceCompress or ((GetFileAttributes(PChar(ExtractFilePath(FileName))) and
FILE_ATTRIBUTE_COMPRESSED) <> 0) then
begin
Result := False;
if (GetFileAttributes(FileName) and FILE_ATTRIBUTE_COMPRESSED) = 0 then
begin
hnd := CreateFile(FileName, GENERIC_READ + GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0);
try
Comp := COMPRESSION_FORMAT_DEFAULT;
if not DeviceIoControl(hnd, FSCTL_SET_COMPRESSION, @Comp,
SizeOf(SHORT), nil, 0, res, nil) then Exit;
finally
CloseHandle(hnd);
end;
end;
Result := True;
end
else
Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
SetCompressedAttribut(PChar(OpenDialog1.FileName), True);
end;
end;
Delphi - .....................................
neoturk: ...Set a file's compression state ?...
{
To set a file's compression state, use the DeviceIoControl function with the
FSCTL_SET_COMPRESSION operation.
Call the following function with the name of the file to compress and
boolean parameter 'forceCompress'. If that one is true, file will be compressed.
If it is false, the file will be compressed only if its parent folder is
compressed (reason for that parameter: if you MoveFile uncompressed file from
uncompressed folder to compressed folder, file will not become automatically
compressed - at least under some NT 4 service packs).
Ein "compressed" Attribut kann man nicht mit der FileSetAttr Funktion setzen
sondern muss DeviceIoControl Funktion mit dem flag FSCTL_SET_COMPRESSION verwenden:
}
const
COMPRESSION_FORMAT_NONE = 0
COMPRESSION_FORMAT_LZNT1 = 2
COMPRESSION_FORMAT_DEFAULT = 1;
FILE_DEVICE_FILE_SYSTEM = 9;
METHOD_BUFFERED = 0;
FILE_READ_DATA = 1;
FILE_WRITE_DATA = 2;
FSCTL_SET_COMPRESSION = (FILE_DEVICE_FILE_SYSTEM shl 16) or
((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or (16 shl 2) or METHOD_BUFFERED;
function SetCompressedAttribut(FileName: PChar; forceCompress: Boolean): Boolean;
var
hnd: Integer;
Comp: SHORT;
res: DWORD;
begin
if forceCompress or ((GetFileAttributes(PChar(ExtractFilePath(FileName))) and
FILE_ATTRIBUTE_COMPRESSED) <> 0) then
begin
Result := False;
if (GetFileAttributes(FileName) and FILE_ATTRIBUTE_COMPRESSED) = 0 then
begin
hnd := CreateFile(FileName, GENERIC_READ + GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0);
try
Comp := COMPRESSION_FORMAT_DEFAULT;
if not DeviceIoControl(hnd, FSCTL_SET_COMPRESSION, @Comp,
SizeOf(SHORT), nil, 0, res, nil) then Exit;
finally
CloseHandle(hnd);
end;
end;
Result := True;
end
else
Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
SetCompressedAttribut(PChar(OpenDialog1.FileName), True);
end;
end;
Delphi - .....................................
neoturk: ...Copy a file using a progressbar ?...
{ 1. }
{
You need a TProgressBar on your form for this tip.
Für diesen Tip wird eine TProgressBar benötigt.
}
procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
FromF, ToF: file of byte;
Buffer: array[0..4096] of char;
NumRead: integer;
FileLength: longint;
begin
AssignFile(FromF, Source);
reset(FromF);
AssignFile(ToF, Destination);
rewrite(ToF);
FileLength := FileSize(FromF);
with Progressbar1 do
begin
Min := 0;
Max := FileLength;
while FileLength > 0 do
begin
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF, Buffer[0], NumRead);
Position := Position + NumRead;
end;
CloseFile(FromF);
CloseFile(ToF);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CopyFileWithProgressBar1('c:WindowsWelcome.exe', 'c:tempWelcome.exe');
end;
{ 2. }
{***************************************}
// To show the estimated time to copy a file:
procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
FromF, ToF: file of byte;
Buffer: array[0..4096] of char;
NumRead: integer;
FileLength: longint;
t1, t2: DWORD;
maxi: integer;
begin
AssignFile(FromF, Source);
reset(FromF);
AssignFile(ToF, Destination);
rewrite(ToF);
FileLength := FileSize(FromF);
with Progressbar1 do
begin
Min := 0;
Max := FileLength;
t1 := TimeGetTime;
maxi := Max div 4096;
while FileLength > 0 do
begin
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF, Buffer[0], NumRead);
t2 := TimeGetTime;
Min := Min + 1;
// Show the time in Label1
label1.Caption := FormatFloat('0.00', ((t2 - t1) / min * maxi - t2 + t1) / 100);
Application.ProcessMessages;
Position := Position + NumRead;
end;
CloseFile(FromF);
CloseFile(ToF);
end;
end;
{ 3. }
{***************************************}
// To show the estimated time to copy a file, using a callback function:
type
TCallBack = procedure(Position, Size: Longint); { export; }
procedure FastFileCopy(const InFileName, OutFileName: string;
CallBack: TCallBack);
implementation
procedure FastFileCopyCallBack(Position, Size: Longint);
begin
Form1.ProgressBar1.Max := Size;
Form1.ProgressBar1.Position := Position;
end;
procedure FastFileCopy(const InFileName, OutFileName: string;
CallBack: TCallBack);
const
BufSize = 3 * 4 * 4096; { 48Kbytes gives me the best results }
type
PBuffer = ^TBuffer;
TBuffer = array[1..BufSize] of Byte;
var
Size: DWORD;
Buffer: PBuffer;
infile, outfile: file;
SizeDone, SizeFile: LongInt;
begin
if (InFileName <> OutFileName) then
begin
buffer := nil;
Assign(infile, InFileName);
Reset(infile, 1);
try
SizeFile := FileSize(infile);
Assign(outfile, OutFileName);
Rewrite(outfile, 1);
try
SizeDone := 0;
New(Buffer);
repeat
BlockRead(infile, Buffer^, BufSize, Size);
Inc(SizeDone, Size);
CallBack(SizeDone, SizeFile);
BlockWrite(outfile, Buffer^, Size)
until Size < BufSize;
FileSetDate(TFileRec(outfile).Handle,
FileGetDate(TFileRec(infile).Handle));
finally
if Buffer <> nil then
Dispose(Buffer);
CloseFile(outfile)
end;
finally
CloseFile(infile);
end;
end
else
raise EInOutError.Create('File cannot be copied onto itself')
end; {FastFileCopy}
procedure TForm1.Button1Click(Sender: TObject);
begin
FastFileCopy('c:daten.txt', 'c:testdaten2.txt', @FastFileCopyCallBack);
end;
{ 4. }
{***************************************}
function CopyFileWithProgressBar2(TotalFileSize,
TotalBytesTransferred,
StreamSize,
StreamBytesTransferred: LARGE_INTEGER;
dwStreamNumber,
dwCallbackReason: DWORD;
hSourceFile,
hDestinationFile: THandle;
lpData: Pointer): DWORD; stdcall;
begin
// just set size at the beginning
if dwCallbackReason = CALLBACK_STREAM_SWITCH then
TProgressBar(lpData).Max := TotalFileSize.QuadPart;
TProgressBar(lpData).Position := TotalBytesTransferred.QuadPart;
Application.ProcessMessages;
Result := PROGRESS_CONTINUE;
end;
function TForm1.CopyWithProgress(sSource, sDest: string): Boolean;
begin
// set this FCancelled to true, if you want to cancel the copy operation
FCancelled := False;
Result := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2,
ProgressBar1, @FCancelled, 0);
end;
end;
{***************************************}
Delphi - .....................................
neoturk: ...Copy a file using a progressbar ?...
{ 1. }
{
You need a TProgressBar on your form for this tip.
Für diesen Tip wird eine TProgressBar benötigt.
}
procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
FromF, ToF: file of byte;
Buffer: array[0..4096] of char;
NumRead: integer;
FileLength: longint;
begin
AssignFile(FromF, Source);
reset(FromF);
AssignFile(ToF, Destination);
rewrite(ToF);
FileLength := FileSize(FromF);
with Progressbar1 do
begin
Min := 0;
Max := FileLength;
while FileLength > 0 do
begin
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF, Buffer[0], NumRead);
Position := Position + NumRead;
end;
CloseFile(FromF);
CloseFile(ToF);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CopyFileWithProgressBar1('c:WindowsWelcome.exe', 'c:tempWelcome.exe');
end;
{ 2. }
{***************************************}
// To show the estimated time to copy a file:
procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);
var
FromF, ToF: file of byte;
Buffer: array[0..4096] of char;
NumRead: integer;
FileLength: longint;
t1, t2: DWORD;
maxi: integer;
begin
AssignFile(FromF, Source);
reset(FromF);
AssignFile(ToF, Destination);
rewrite(ToF);
FileLength := FileSize(FromF);
with Progressbar1 do
begin
Min := 0;
Max := FileLength;
t1 := TimeGetTime;
maxi := Max div 4096;
while FileLength > 0 do
begin
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF, Buffer[0], NumRead);
t2 := TimeGetTime;
Min := Min + 1;
// Show the time in Label1
label1.Caption := FormatFloat('0.00', ((t2 - t1) / min * maxi - t2 + t1) / 100);
Application.ProcessMessages;
Position := Position + NumRead;
end;
CloseFile(FromF);
CloseFile(ToF);
end;
end;
{ 3. }
{***************************************}
// To show the estimated time to copy a file, using a callback function:
type
TCallBack = procedure(Position, Size: Longint); { export; }
procedure FastFileCopy(const InFileName, OutFileName: string;
CallBack: TCallBack);
implementation
procedure FastFileCopyCallBack(Position, Size: Longint);
begin
Form1.ProgressBar1.Max := Size;
Form1.ProgressBar1.Position := Position;
end;
procedure FastFileCopy(const InFileName, OutFileName: string;
CallBack: TCallBack);
const
BufSize = 3 * 4 * 4096; { 48Kbytes gives me the best results }
type
PBuffer = ^TBuffer;
TBuffer = array[1..BufSize] of Byte;
var
Size: DWORD;
Buffer: PBuffer;
infile, outfile: file;
SizeDone, SizeFile: LongInt;
begin
if (InFileName <> OutFileName) then
begin
buffer := nil;
Assign(infile, InFileName);
Reset(infile, 1);
try
SizeFile := FileSize(infile);
Assign(outfile, OutFileName);
Rewrite(outfile, 1);
try
SizeDone := 0;
New(Buffer);
repeat
BlockRead(infile, Buffer^, BufSize, Size);
Inc(SizeDone, Size);
CallBack(SizeDone, SizeFile);
BlockWrite(outfile, Buffer^, Size)
until Size < BufSize;
FileSetDate(TFileRec(outfile).Handle,
FileGetDate(TFileRec(infile).Handle));
finally
if Buffer <> nil then
Dispose(Buffer);
CloseFile(outfile)
end;
finally
CloseFile(infile);
end;
end
else
raise EInOutError.Create('File cannot be copied onto itself')
end; {FastFileCopy}
procedure TForm1.Button1Click(Sender: TObject);
begin
FastFileCopy('c:daten.txt', 'c:testdaten2.txt', @FastFileCopyCallBack);
end;
{ 4. }
{***************************************}
function CopyFileWithProgressBar2(TotalFileSize,
TotalBytesTransferred,
StreamSize,
StreamBytesTransferred: LARGE_INTEGER;
dwStreamNumber,
dwCallbackReason: DWORD;
hSourceFile,
hDestinationFile: THandle;
lpData: Pointer): DWORD; stdcall;
begin
// just set size at the beginning
if dwCallbackReason = CALLBACK_STREAM_SWITCH then
TProgressBar(lpData).Max := TotalFileSize.QuadPart;
TProgressBar(lpData).Position := TotalBytesTransferred.QuadPart;
Application.ProcessMessages;
Result := PROGRESS_CONTINUE;
end;
function TForm1.CopyWithProgress(sSource, sDest: string): Boolean;
begin
// set this FCancelled to true, if you want to cancel the copy operation
FCancelled := False;
Result := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2,
ProgressBar1, @FCancelled, 0);
end;
end;
{***************************************}
