I am trying to copy a file to the clipboard. All examples in Internet are the same. I am using one from, http://embarcadero.newsgroups.archived.at/public.delphi.nativeapi/200909/0909212186.html but it does not work.
I use Rad Studio XE and I pass the complete path. In mode debug, I get some warnings like:
Debug Output:
Invalid address specified to RtlSizeHeap( 006E0000, 007196D8 )
Invalid address specified to RtlSizeHeap( 006E0000, 007196D8 )
I am not sure is my environment is related: Windows 8.1 64 bits, Rad Studio XE.
When I try to paste the clipboard, nothing happens. Also, seeing the clipboard with a monitor tool, this tool shows me error.
The code is:
procedure TfrmDoc2.CopyFilesToClipboard(FileList: string);
var
DropFiles: PDropFiles;
hGlobal: THandle;
iLen: Integer;
begin
iLen := Length(FileList) + 2;
FileList := FileList + #0#0;
hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
SizeOf(TDropFiles) + iLen);
if (hGlobal = 0) then raise Exception.Create('Could not allocate memory.');
begin
DropFiles := GlobalLock(hGlobal);
DropFiles^.pFiles := SizeOf(TDropFiles);
Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);
GlobalUnlock(hGlobal);
Clipboard.SetAsHandle(CF_HDROP, hGlobal);
end;
end;
UPDATE:
I am sorry, I feel stupid. I used the code that did not work, the original question that somebody asked, in my project, while I used the Remy's code, the correct solution, here in Stackoverflow. I thought that I used the Remy's code in my project. So, now, using the Remy's code, everything works great. Sorry for the mistake.
The forum post you link to contains the code in your question and asks why it doesn't work. Not surprisingly the code doesn't work for you any more than it did for the asker.
The answer that Remy gives is that there is a mismatch between ANSI and Unicode. The code is for ANSI but the compiler is Unicode.
So click on Remy's reply and do what it says: http://embarcadero.newsgroups.archived.at/public.delphi.nativeapi/200909/0909212187.html
Essentially you need to adapt the code to account for characters being 2 bytes wide in Unicode Delphi, but I see no real purpose repeating Remy's code here.
However, I'd say that you can do better than this code. The problem with this code is that it mixes every aspect all into one big function that does it all. What's more, the function is a method of a form in your GUI which is really the wrong place for it. There are aspects of the code that you might be able to re-use, but not factored like that.
I'd start with a function that puts an known block of memory into the clipboard.
procedure ClipboardError;
begin
raise Exception.Create('Could not complete clipboard operation.');
// substitute something more specific that Exception in your code
end;
procedure CheckClipboardHandle(Handle: HGLOBAL);
begin
if Handle=0 then begin
ClipboardError;
end;
end;
procedure CheckClipboardPtr(Ptr: Pointer);
begin
if not Assigned(Ptr) then begin
ClipboardError;
end;
end;
procedure PutInClipboard(ClipboardFormat: UINT; Buffer: Pointer; Count: Integer);
var
Handle: HGLOBAL;
Ptr: Pointer;
begin
Clipboard.Open;
Try
Handle := GlobalAlloc(GMEM_MOVEABLE, Count);
Try
CheckClipboardHandle(Handle);
Ptr := GlobalLock(Handle);
CheckClipboardPtr(Ptr);
Move(Buffer^, Ptr^, Count);
GlobalUnlock(Handle);
Clipboard.SetAsHandle(ClipboardFormat, Handle);
Except
GlobalFree(Handle);
raise;
End;
Finally
Clipboard.Close;
End;
end;
We're also going to need to be able to make double-null terminated lists of strings. Like this:
function DoubleNullTerminatedString(const Values: array of string): string;
var
Value: string;
begin
Result := '';
for Value in Values do
Result := Result + Value + #0;
Result := Result + #0;
end;
Perhaps you might add an overload that accepted a TStrings instance.
Now that we have all this we can concentrate on making the structure needed for the CF_HDROP format.
procedure CopyFileNamesToClipboard(const FileNames: array of string);
var
Size: Integer;
FileList: string;
DropFiles: PDropFiles;
begin
FileList := DoubleNullTerminatedString(FileNames);
Size := SizeOf(TDropFiles) + ByteLength(FileList);
DropFiles := AllocMem(Size);
try
DropFiles.pFiles := SizeOf(TDropFiles);
DropFiles.fWide := True;
Move(Pointer(FileList)^, (PByte(DropFiles) + SizeOf(TDropFiles))^,
ByteLength(FileList));
PutInClipboard(CF_HDROP, DropFiles, Size);
finally
FreeMem(DropFiles);
end;
end;
Since you use Delphi XE, strings are Unicode, but you are not taking the size of character into count when you allocate and move memory.
Change the line allocating memory to
hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
SizeOf(TDropFiles) + iLen * SizeOf(Char));
and the line copying memory, to
Move(FileList[1], (PByte(DropFiles) + SizeOf(TDropFiles))^, iLen * SizeOf(Char));
Note the inclusion of *SizeOf(Char) in both lines and change of PChar to PByte on second line.
Then, also set the fWide member of DropFiles to True
DropFiles^.fWide := True;
All of these changes are already in the code from Remy, referred to by David.
Related
Using Delphi 10.4 Community Edition, VCL, Windows 10 64bit, although the compiled .exe application is 32bit.
The VCL's TMediaPlayer seems to have a file path/name length limit of 128 characters. Is this really an internal limitation? Is there any way to access longer file paths/names?
I was coding a small soundPad player by using the TMediaPlayer component.
The installer I am using installs the .exe program in the user's home directory, and at the same time a few sample audio files in the program's root directory.
In this case, the path to the audio file may be quite long. For example:
C:\Users\user\AppData\Local\Programs\MySoundPlayer\ThisIsMySoundWithAVeryLongFileNameThereIsSomeCopyrightInfoAndSomeOther.wav
When trying to play such a file, TMediaPlayer will give an error message:
Exception class name = 'EMCIDeviceError'
Exception message = 'Invalid filename. Make sure the filename has 8 characters, a period, and an extension.'
I tried different lengths in the file name, and it looks like 127 is the maximum length.
So, the VCL TMediaPlayer component does not recognize file paths / names longer than 127 characters?
I tried the same code with a Delphi FMX app, and FMX's TMediaPlayer worked ok. It seems that the maximum file path and name length of the FMX TMediaPlayer is 259, which is quite sufficient.
The length 259 seem to be the limit of the File Explorer overall...
It is said that the VCL's TMediaPlayer component is starting to become obsolete, and is only involved in backward compatibility reasons. But what can replace it in the future?
So, I guess I have to move on to FMX and learn its secrets. Is VCL a receding component system?
procedure TForm1.PlayButtonClick(Sender: TObject);
var
pathstring, playerfilename, playstring : string;
begin
try
pathstring := ExtractFilePath(Application.ExeName);
playerfilename := 'ThisIsMySoundWithAVeryLongFileNameThereIsSomeCopyrightInfoAndSomeOther.wav';
playstring := pathstring + playerfilename;
MediaPlayer1.FileName := playstring;
MediaPlayer1.Open;
MediaPlayer1.Play;
except
on E : Exception do
begin
ShowMessage('Exception class name = ' + E.ClassName);
ShowMessage('Exception message = ' + E.Message);
end;
end;
end;
Per this answer to mciSendString() won't play an audio file if path is too long:
Here, mmioOpen is called with MMIO_PARSE flag to convert file path to fully qualified file path. According to MSDN, this has a limitation:
The buffer must be large enough to hold at least 128 characters.
That is, buffer is always assumed to be 128 bytes long. For long filenames, the buffer turns out to be insufficient and mmioOpen returns error, causing mciSendCommand to think that sound file is missing and return MCIERR_FILENAME_REQUIRED.
The Invalid filename error message you are seeing is the system text for the MCIERR_FILENAME_REQUIRED error code.
The VCL's TMediaPlayer is based on MCI and internally uses mciSendCommand(), which is just the binary version of mciSendString(). They both suffer from the same problem.
The preferred fix is to either use shorter paths, or use a more modern audio API.
However, since mmioInstallIOProc() can be used to let TMediaPlayer play media files from memory instead of files, I think a similar solution could be used to play files with long file paths, since you could take over the responsibility of opening/reading/seeking a file, bypassing the path limitation of the troublesome mmioOpen(). Just replace the TResourceStream in that code with a TFileStream, and update the MMIOM_READ and MMIOM_SEEK handlers accordingly to read/seek that TFileStream.
For example (untested, might need some tweaking):
uses
Winapi.MMSystem;
var
ccRES: FOURCC;
playstring: string;
function MAKEFOURCC(ch0, ch1, ch2, ch3: BYTE): FOURCC;
begin
Result := DWORD(ch0) or (DWORD(ch1) shl 8) or (DWORD(ch2) shl 16) or (DWORD(ch3) shl 24);
end;
function MyLongFileIOProc(lpMMIOInfo: PMMIOInfo; uMessage: UINT; lParam1, lParam2: LPARAM): LRESULT; stdcall;
var
FStrm: TFileStream;
NumRead: Integer;
function GetFileStream: TFileStream;
begin
Move(lpMMIOInfo.adwInfo, Result, SizeOf(TFileStream));
end;
procedure SetFileStream(Stream: TFileStream);
begin
Move(Stream, lpMMIOInfo.adwInfo, SizeOf(TFileStream));
end;
begin
if uMessage = MMIOM_OPEN then
begin
try
FStrm := TFileStream.Create(playstring, fmOpenRead or fmShareDenyWrite);
except
SetFileStream(nil);
Exit(MMIOM_CANNOTOPEN);
end;
SetFileStream(FStrm);
lpMMIOInfo.lDiskOffset := 0;
end else
begin
FStrm := GetFileStream;
case uMessage of
MMIOM_CLOSE: begin
SetFileStream(nil);
FStrm.Free;
end;
MMIOM_READ: begin
NumRead := FStrm.Read(Pointer(lParam1)^, lParam2);
Inc(lpMMIOInfo.lDiskOffset, NumRead);
Exit(NumRead);
end;
MMIOM_SEEK: begin
FStrm.Seek(Int64(lParam1), TSeekOrigin(lParam2));
lpMMIOInfo.lDiskOffset := FStrm.Position;
Exit(lpMMIOInfo.lDiskOffset);
end;
end;
Exit(MMSYSERR_NOERROR);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ccRES := MAKEFOURCC(Ord('L'), Ord('F'), Ord('N'), Ord(' '));
mmioInstallIOProc(ccRES, TFNMMIOProc(MyLongFileIOProc), MMIO_INSTALLPROC);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
mmioInstallIOProc(ccRES, nil, MMIO_REMOVEPROC);
end;
procedure TForm1.PlayButtonClick(Sender: TObject);
var
pathstring, playerfilename : string;
begin
try
pathstring := ExtractFilePath(Application.ExeName);
playerfilename := 'ThisIsMySoundWithAVeryLongFileNameThereIsSomeCopyrightInfoAndSomeOther.wav';
playstring := pathstring + playerfilename;
MediaPlayer1.DeviceType := dtWaveAudio;
MediaPlayer1.FileName := 'playstring.LFN+';
MediaPlayer1.Open;
MediaPlayer1.Play;
except
on E : Exception do
begin
ShowMessage('Exception class name = ' + E.ClassName);
ShowMessage('Exception message = ' + E.Message);
end;
end;
end;
I am working on an application which was recently upgraded from Delphi 2007 to XE7. There is one particular scenario where the conversion of TMemoryStream to PChar is failing. Here is the code:
procedure TCReport.CopyToClipboard;
var
CTextStream: TMemoryStream;
PValue: PChar;
begin
CTextStream := TMemoryStream.Create;
//Assume that this code is saving a report column to CTextStream
//Verified that the value in CTextStream is correct
Self.SaveToTextStream(CTextStream);
//The value stored in PValue below is corrupt
PValue := StrAlloc(CTextStream.Size + 1);
CTextStream.Read(PValue^, CTextStream.Size + 1);
PValue[CTextStream.Size] := #0;
{ Copy text stream to clipboard }
Clipboard.Clear;
Clipboard.SetTextBuf(PValue);
CTextStream.Free;
StrDispose(PValue);
end;
Adding the code for SaveToTextStream:
procedure TCReport.SaveToTextStream(CTextStream: TStream);
var
CBinaryMemoryStream: TMemoryStream;
CWriter: TWriter;
begin
CBinaryMemoryStream := TMemoryStream.Create;
CWriter := TWriter.Create(CBinaryMemoryStream, 24);
try
CWriter.Ancestor := nil;
CWriter.WriteRootComponent(Self);
CWriter.Free;
CBinaryMemoryStream.Position := 0;
{ Convert Binary 'WriteComponent' stream to text}
ObjectBinaryToText(CBinaryMemoryStream, CTextStream);
CTextStream.Position := 0;
finally
CBinaryMemoryStream.Free;
end;
end;
I observed that the StrLen(PChar) is also coming out to be half the size of TMemoryStream. But in Delphi 2007 it was coming out to be same as the size of TMemoryStream.
I know that the above code is assuming the size of a char to be 1 byte, and that could be a problem. But I tried multiple approaches, and nothing works.
Could you suggest a better way to go about this conversion?
Yet again, this is the issue of Delphi 2009 and later using Unicode text. In Delphi 2007 and earlier:
Char is an alias to AnsiChar.
PChar is an alias to PAnsiChar.
string is an alias to AnsiString.
In Delphi 2009 and later:
Char is an alias to WideChar.
PChar is an alias to PWideChar.
string is an alias to UnicodeString.
Your code is written assuming that PChar is PAnsiChar. Hence your problems. You need to stop using StrAlloc anyway. You are making life hard for yourself by manually allocating heap memory here. Let the compiler do the work.
You need to obtain your text in a string variable, and then simply do:
Clipboard.AsText := MyStrVariable;
Exactly how best to obtain the string depends on the facilities that TCReport offers. I expect that it will yield a string directly in which case you'll write something like this:
procedure TCReport.CopyToClipboard;
begin
Clipboard.AsText := Self.ReportAsText;
end;
I'm guessing as to what your functionality your TCReport offers, but I'm sure you know.
By reffering to what hvd and David Heffernan wrote above, one possible way is to change CTextStream on CopyToClipboard to TStringStream as follow :
procedure TCReport.CopyToClipboard;
var
CTextStream: TStringStream;
begin
CTextStream := TStringStream.Create;
try
//Assume no error with Self.SaveToTextStream
Self.SaveToTextStream(CTextStream);
{ Copy text stream to clipboard }
Clipboard.AsText := CTextStream.DataString;
finally
CTextStream.Free;
end;
end;
But you should make sure that SaveToTextStream function provides CTextStream with the exact encoding text data.
I'm not quite sure how to even ask this question, since I don't know whether it is related to the execution time, application process.message procedure or anything else.
I'm having (for me) weird situations, where the procedure fails to run and raises system exception on run, while it runs completely flawless if I put "showmessage" there in between (which I put so that I could quickly see what's going on in between. I prefer that way over watches somehow...).
I'm not sure whether the code matters or not, but I'll give it below:
procedure LoadSettings;
var SettingsBuffToLoad: TStringList;
begin
SettingsBuffToLoad:=TStringList.Create;
Encoding:=TEncoding.ANSI;
SettingsBuffToLoad.LoadFromFile('bin/settings.txt', Encoding);
// showmessage(settingsbufftoload.Strings[0]);
SettingsBuffer:=Decode(SettingsBuffToLoad);
// showmessage(settingsbuffer.Strings[0]); //decode
end;
The Decode procedure is declared as external and is read from the dll.
If I just remove those "/" , so that it becomes the code instead of comment, it works just fine. However, set as you see now, it raises exception, but after the procedure is already done. (the debugger last break point is stopped at "end;", after continuing however it raises exception instead of showing the form; this procedure is called as the last thing in FormCreate procedure.
Is there anything that has to do with the timing, which ShowMessage solves, or...? :/
Update:
The decode functions, as asked:
this is how it's declared, right above of the implementation and variables of the form:
function Decode(Buff: TStringList): TStringList; StdCall; external 'bin\settings.txt';
And this is in the dll:
function Decode(Buff: TStringList): TStringList; export;
var
t, u, h: integer;
s: String;
begin
DecodeBuffer.Clear;
DecodeBuffer:=Buff;
for h := 0 to DecodeBuffer.Count-1 do
begin
s := DecodeBuffer.Strings[h];
t := Length(s);
if t > 0 then
begin
for u := 0 to t-1 do
begin
s[u+1] := DecodeChar(s[u+1], (h mod 5) + 1);
end;
DecodeBuffer.Strings[h] := s;
end;
end;
Result:=DecodeBuffer;
end;
This code was discussed in a question at Delphi changing Chars in string - missunderstood behavior - XE3 and is used from Remy's answer. The DecodeChar is, I believe simply unimportant here, or is it?
Also, the same goes with the function to save settings, which is called at FormClose event:
This is:
procedure TScribbles.SaveSettings;
var SettingsBuffToSave: TStringList;
begin
SettingsBuffToSave:=TStringList.Create;
Encoding := TEncoding.ANSI;
// Showmessage(settingsbuffer.Strings[0]);
SettingsBuffToSave:=Encode(SettingsBuffer);
// Showmessage(settingsbufftosave.Strings[0]);
SettingsBuffToSave.SaveToFile('bin/settings.txt', Encoding);
end;
With the first ShowMessage used as code instead of comment, it works, while otherwise in a comment function as it is written above, it calls external exception the same way as on Decode.
Is it possible, that the SettingsBuffToSave is just not yet created when it already calls the function Encode, or what?
At that time, the SettingsBuffer exists and is populated, so it really seems weird that it raises errors, which disappears with simply putting ShowMessage in there.
(Function Encode is basically a mirror of Decode, so the code is not important here...)
This code is VERY VERY VERY dangerous on many levels. Using objects across the DLL boundary in an unsafe manner. Mismanagement of object pointers across function calls. You need a redesign. Try the following as a start:
procedure Decode(Buff: PChar; BuffLen: Integer; ListIndex: Integer); stdcall; export;
var
u: integer;
begin
for u := 0 to BuffLen-1 do
begin
Buff^ := DecodeChar(Buff^, (ListIndex mod 5) + 1);
Inc(Buff);
end;
end;
procedure Encode(Buff: PChar; BuffLen: Integer; ListIndex: Integer); stdcall; export;
var
u: integer;
begin
for u := 0 to BuffLen-1 do
begin
Buff^ := EncodeChar(Buff^, (ListIndex mod 5) + 1);
Inc(Buff);
end;
end;
procedure Decode(Buff: PChar; BuffLen: Integer; ListIndex: Integer); stdcall; external '...';
procedure Encode(Buff: PChar; BuffLen: Integer; ListIndex: Integer); stdcall; external '...';
procedure LoadSettings;
var
h: Integer;
begin
SettingsBuffer := TStringList.Create;
SettingsBuffer.LoadFromFile('bin/settings.txt', TEncoding.ANSI);
for h := 0 to SettingsBuff.Count-1 do
begin
Decode(PChar(SettingsBuff[h]), Length(SettingsBuff[h]), h);
end;
end;
procedure TScribbles.SaveSettings;
var
h: Integer;
begin
for h := 0 to SettingsBuff.Count-1 do
begin
Encode(PChar(SettingsBuff[h]), Length(SettingsBuff[h]), h);
end;
SettingsBuff.SaveToFile('bin/setpb95enc.dll', TEncoding.ANSI);
end;
The obvious problem here is that the code exists in a DLL. Most likely you didn't arrange for the DLL to share its host's heap. And a Delphi class cannot be passed across a DLL boundary.
If you want to share Delphi classes between modules, you must use packages. Of course, another option is to put all the code in the same module. That is remove the DLL, and compile everything in the executable. The final option is to use valid interop types for DLLs.
Of course, there could be other reasons for the actual error. The code smells bad. For instance, what is this:
DecodeBuffer:=Buff;
Is DecodeBuffer a global variable? If so then it is plausible that you refer to the object after it has been destroyed. Not that I can see evidence of anything being destroyed. Without wishing to seem rude, your code looks like it may have multiple problems. As a matter of urgency you need to:
Deal with the DLL problem described above.
Remove global variables.
Fix lifetime issues. Stop leaking.
Enable range checking to locate buffer overruns.
Add FastMM in debug mode to try to catch heap corruptions.
I think I know what's going on here: I think your stack is getting smashed.
Furthermore, I rather suspect the actual cause is the Decode procedure using an uninitialized variable. Your ShowMessage statement (it would be the first one that matters if I'm right) changes what's on the stack and thus changes the uninitialized variable.
If I'm right this is going to have some heisenbug attributes--anything you do to find out what's going on will change the value of the uninitialized variable.
One thing to try: Declare a large local variable (the idea is to use up stack space) and make sure it's not discarded by the compiler. This will move things in memory and thus likely defuse the blowup. If it works it's pretty conclusive at to what's going on.
i have the following code snippit that won't compile:
procedure Frob(const Grob: WideString);
var
s: WideString;
begin
s :=
Grob[7]+Grob[8]+Grob[5]+Grob[6]+Grob[3]+Grob[4]+Grob[1]+Grob[2];
...
end;
Delphi5 complains Incompatible types.
i tried simplifying it down to:
s := Grob[7];
which works, and:
s := Grob[7]+Grob[8];
which does not.
i can only assume that WideString[index] does not return a WideChar.
i tried forcing things to be WideChars:
s := WideChar(Grob[7])+WideChar(Grob[8]);
But that also fails:
Incompatible types
Footnotes
5: Delphi 5
The easier, and faster, in your case, is the following code:
procedure Frob(const Grob: WideString);
var
s: WideString;
begin
SetLength(s,8);
s[1] := Grob[7];
s[2] := Grob[8];
s[3] := Grob[5];
s[4] := Grob[6];
s[5] := Grob[3];
s[6] := Grob[4];
s[7] := Grob[1];
s[8] := Grob[2];
...
end;
Using a WideString(Grob[7])+WideString(Grob[8]) expression will work (it circumvent the Delphi 5 bug by which you can't make a WideString from a concatenation of WideChars), but is much slower.
Creation of a WideString is very slow: it does not use the Delphi memory allocator, but the BSTR memory allocator supplied by Windows (for OLE), which is damn slow.
Grob[7] is a WideChar; that's not the issue.
The issue seems to be that the + operator cannot act on wide chars. But it can act on wide strings, and any wide char can be cast to a wide string:
S := WideString(Grob[7]) + WideString(Grob[8]);
As Geoff pointed out my other question dealing with WideString weirdness in Delphi, i randomly tried my solution from there:
procedure Frob(const Grob: WideString);
var
s: WideString;
const
n: WideString = ''; //n=nothing
begin
s :=
n+Grob[7]+Grob[8]+Grob[5]+Grob[6]+Grob[3]+Grob[4]+Grob[1]+Grob[2];
end;
And it works. Delphi is confused about what type a WideString[index] in, so i have to beat it over the head.
i want to process a text file line by line. In the olden days i loaded the file into a StringList:
slFile := TStringList.Create();
slFile.LoadFromFile(filename);
for i := 0 to slFile.Count-1 do
begin
oneLine := slFile.Strings[i];
//process the line
end;
Problem with that is once the file gets to be a few hundred megabytes, i have to allocate a huge chunk of memory; when really i only need enough memory to hold one line at a time. (Plus, you can't really indicate progress when you the system is locked up loading the file in step 1).
The i tried using the native, and recommended, file I/O routines provided by Delphi:
var
f: TextFile;
begin
Reset(f, filename);
while ReadLn(f, oneLine) do
begin
//process the line
end;
Problem withAssign is that there is no option to read the file without locking (i.e. fmShareDenyNone). The former stringlist example doesn't support no-lock either, unless you change it to LoadFromStream:
slFile := TStringList.Create;
stream := TFileStream.Create(filename, fmOpenRead or fmShareDenyNone);
slFile.LoadFromStream(stream);
stream.Free;
for i := 0 to slFile.Count-1 do
begin
oneLine := slFile.Strings[i];
//process the line
end;
So now even though i've gained no locks being held, i'm back to loading the entire file into memory.
Is there some alternative to Assign/ReadLn, where i can read a file line-by-line, without taking a sharing lock?
i'd rather not get directly into Win32 CreateFile/ReadFile, and having to deal with allocating buffers and detecting CR, LF, CRLF's.
i thought about memory mapped files, but there's the difficulty if the entire file doesn't fit (map) into virtual memory, and having to maps views (pieces) of the file at a time. Starts to get ugly.
i just want Reset with fmShareDenyNone!
With recent Delphi versions, you can use TStreamReader. Construct it with your file stream, and then call its ReadLine method (inherited from TTextReader).
An option for all Delphi versions is to use Peter Below's StreamIO unit, which gives you AssignStream. It works just like AssignFile, but for streams instead of file names. Once you've used that function to associate a stream with a TextFile variable, you can call ReadLn and the other I/O functions on it just like any other file.
You can use this sample code:
TTextStream = class(TObject)
private
FHost: TStream;
FOffset,FSize: Integer;
FBuffer: array[0..1023] of Char;
FEOF: Boolean;
function FillBuffer: Boolean;
protected
property Host: TStream read FHost;
public
constructor Create(AHost: TStream);
destructor Destroy; override;
function ReadLn: string; overload;
function ReadLn(out Data: string): Boolean; overload;
property EOF: Boolean read FEOF;
property HostStream: TStream read FHost;
property Offset: Integer read FOffset write FOffset;
end;
{ TTextStream }
constructor TTextStream.Create(AHost: TStream);
begin
FHost := AHost;
FillBuffer;
end;
destructor TTextStream.Destroy;
begin
FHost.Free;
inherited Destroy;
end;
function TTextStream.FillBuffer: Boolean;
begin
FOffset := 0;
FSize := FHost.Read(FBuffer,SizeOf(FBuffer));
Result := FSize > 0;
FEOF := Result;
end;
function TTextStream.ReadLn(out Data: string): Boolean;
var
Len, Start: Integer;
EOLChar: Char;
begin
Data:='';
Result:=False;
repeat
if FOffset>=FSize then
if not FillBuffer then
Exit; // no more data to read from stream -> exit
Result:=True;
Start:=FOffset;
while (FOffset<FSize) and (not (FBuffer[FOffset] in [#13,#10])) do
Inc(FOffset);
Len:=FOffset-Start;
if Len>0 then begin
SetLength(Data,Length(Data)+Len);
Move(FBuffer[Start],Data[Succ(Length(Data)-Len)],Len);
end else
Data:='';
until FOffset<>FSize; // EOL char found
EOLChar:=FBuffer[FOffset];
Inc(FOffset);
if (FOffset=FSize) then
if not FillBuffer then
Exit;
if FBuffer[FOffset] in ([#13,#10]-[EOLChar]) then begin
Inc(FOffset);
if (FOffset=FSize) then
FillBuffer;
end;
end;
function TTextStream.ReadLn: string;
begin
ReadLn(Result);
end;
Usage:
procedure ReadFileByLine(Filename: string);
var
sLine: string;
tsFile: TTextStream;
begin
tsFile := TTextStream.Create(TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite));
try
while tsFile.ReadLn(sLine) do
begin
//sLine is your line
end;
finally
tsFile.Free;
end;
end;
If you need support for ansi and Unicode in older Delphis, you can use my GpTextFile or GpTextStream.
As it seems the FileMode variable is not valid for Textfiles, but my tests showed that multiple reading from the file is no problem. You didn't mention it in your question, but if you are not going to write to the textfile while it is read you should be good.
What I do is use a TFileStream but I buffer the input into fairly large blocks (e.g. a few megabytes each) and read and process one block at a time. That way I don't have to load the whole file at once.
It works quite quickly that way, even for large files.
I do have a progress indicator. As I load each block, I increment it by the fraction of the file that has additionally been loaded.
Reading one line at a time, without something to do your buffering, is simply too slow for large files.
I had same problem a few years ago especially the problem of locking the file. What I did was use the low level readfile from the shellapi. I know the question is old since my answer (2 years) but perhaps my contribution could help someone in the future.
const
BUFF_SIZE = $8000;
var
dwread:LongWord;
hFile: THandle;
datafile : array [0..BUFF_SIZE-1] of char;
hFile := createfile(PChar(filename)), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_READONLY, 0);
SetFilePointer(hFile, 0, nil, FILE_BEGIN);
myEOF := false;
try
Readfile(hFile, datafile, BUFF_SIZE, dwread, nil);
while (dwread > 0) and (not myEOF) do
begin
if dwread = BUFF_SIZE then
begin
apos := LastDelimiter(#10#13, datafile);
if apos = BUFF_SIZE then inc(apos);
SetFilePointer(hFile, aPos-BUFF_SIZE, nil, FILE_CURRENT);
end
else myEOF := true;
Readfile(hFile, datafile, BUFF_SIZE, dwread, nil);
end;
finally
closehandle(hFile);
end;
For me the speed improvement appeared to be significant.
Why not simply read the lines of the file directly from the TFileStream itself one at a time ?
i.e. (in pseudocode):
readline:
while NOT EOF and (readchar <> EOL) do
appendchar to result
while NOT EOF do
begin
s := readline
process s
end;
One problem you may find with this is that iirc TFileStream is not buffered so performance over a large file is going to be sub-optimal. However, there are a number of solutions to the problem of non-buffered streams, including this one, that you may wish to investigate if this approach solves your initial problem.