I keep getting a read error when copying stream data - delphi

I am attempting to copy data from a TStringStream contained in a TStreamReader into another TStringStream using the CopyFrom method. If there have been no reads of the source stream it works as advertised, however if I perform a single read of the streamreader it throws an exception with EReadError: Stream read Error. Code to show problem:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
System.classes;
var
FStreamRead : TStreamReader;
AChar : char;
OutStream : TStringStream;
begin
FStreamRead := TStreamReader.Create(TStringStream.Create('This is test data',TEncoding.UTF8));
FStreamRead.OwnStream;
try
try
// read once
Achar := char (FStreamRead.Read);
OutStream := TStringStream.Create;
try
OutStream.CopyFrom(FStreamRead.BaseStream,4);
finally
OutStream.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
finally
FStreamRead.Free;
readln;
end;
end.
Commenting out the line:
Achar := char (FStreamRead.Read);
allows the copy to be done without error. The documentation states that if count is greater than zero in the TStream.CopyFrom method it performs the copy from the current position in the input stream which is what I need to achieve.

TStreamReader internally uses buffering. You are simply not allowed to use the BaseStream from outside.

Related

TStreamWriter locks file for Read

In our project, we are using a StreamWriter to write into a log file.
While writing, I wanted to search inside the file for some specific lines. E.g. during a unit test. But somehow I can't read from the file, because it is blocked by a process. I don't understand why it is blocked, because I think I opened the FileStream without any blocking.
I extracted everything from to project into this little example.
What do I have to change to not block the file for reading, while writing to it?
program Playground;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
var
FileStream: TFileStream;
FileStreamWriter : TStreamWriter;
strList: TStringList;
fileName: String;
begin
try
strList := TStringList.Create;
fileName := 'TestFile.txt';
FileStream := TFileStream.Create(fileName, fmCreate or fmShareDenyNone);
FileStreamWriter := TStreamWriter.Create(FileStream, TEncoding.Unicode);
FileStreamWriter.WriteLine('12345');
strList.LoadFromFile(fileName); // Crashes because a proccess blocks the file
strList.Free;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
As Peter Wolf stated in his comment the cause for your troubles doesn't lie in your code but instead in StringList.LoadFromFile code.
You see when string list is trying to load the contents of a file it is opening it in a way that would prevent other applications from reading its contents.
Here is how StringList.LoadFromFile code looks like:
procedure TStrings.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
So in order to avoid this problem you should create yourself another File Stream and than use that file stream to read contents of your file into StringList.
program Playground;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
var
FileStream: TFileStream;
StrListFS: TFileStream;
FileStreamWriter : TStreamWriter;
strList: TStringList;
fileName: String;
begin
try
strList := TStringList.Create;
fileName := 'D:\TestFile.txt';
FileStream := TFileStream.Create(fileName, fmCreate or fmShareDenyNone);
FileStreamWriter := TStreamWriter.Create(FileStream, TEncoding.Unicode);
FileStreamWriter.WriteLine('12345');
//strList.LoadFromFile(fileName); // Crashes because a proccess blocks the file
//Create a new file stream that we will use for reading the file contents into
//our string list.
StrListFS := TFileStream.Create(fileName, fmOpenRead or fmShareDenyNone);
//Load contets from a file into a stream by using our newly created FileStream
strList.LoadFromStream(StrListFS);
//Free the file stream when we are done loading the data.
StrListFS.Free;
strList.Free;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
You could theoretically use same file stream that is used by your stream writer to read the contents of that file into string list but do mind that doing so would change your stream position so you would have to save your previous position before and restore it after reading the contents of your file into your string list.
This way would be able to do this even if you would be opening your stream writer File Stream in locked mode which would prevent opening file by multiple processes/handles.

Unicode in console [duplicate]

Consider this program:
{$APPTYPE CONSOLE}
begin
Writeln('АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ');
end.
The output on my console which uses the Consolas font is:
????????Z??????????????????????????????????????
The Windows console is quite capable of supporting Unicode as evidenced by this program:
{$APPTYPE CONSOLE}
uses
Winapi.Windows;
const
Text = 'АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ';
var
NumWritten: DWORD;
begin
WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), PChar(Text), Length(Text), NumWritten, nil);
end.
for which the output is:
АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ
Can Writeln be persuaded to respect Unicode, or is it inherently crippled?
Just set the console output codepage through the SetConsoleOutputCP() routine with codepage cp_UTF8.
program Project1;
{$APPTYPE CONSOLE}
uses
System.SysUtils,Windows;
Const
Text = 'АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ';
VAR
NumWritten: DWORD;
begin
ReadLn; // Make sure Consolas font is selected
try
WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), PChar(Text), Length(Text), NumWritten, nil);
SetConsoleOutputCP(CP_UTF8);
WriteLn;
WriteLn('АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
ReadLn;
end.
Outputs:
АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ
АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ
WriteLn() translates Unicode UTF16 strings to the selected output codepage (cp_UTF8) internally.
Update:
The above works in Delphi-XE2 and above.
In Delphi-XE you need an explicit conversion to UTF-8 to make it work properly.
WriteLn(UTF8String('АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ'));
Addendum:
If an output to the console is done in another codepage before calling SetConsoleOutputCP(cp_UTF8),
the OS will not correctly output text in utf-8.
This can be fixed by closing/reopening the stdout handler.
Another option is to declare a new text output handler for utf-8.
var
toutUTF8: TextFile;
...
SetConsoleOutputCP(CP_UTF8);
AssignFile(toutUTF8,'',cp_UTF8); // Works in XE2 and above
Rewrite(toutUTF8);
WriteLn(toutUTF8,'АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ');
The System unit declares a variable named AlternateWriteUnicodeStringProc that allows customisation of how Writeln performs output. This program:
{$APPTYPE CONSOLE}
uses
Winapi.Windows;
function MyAlternateWriteUnicodeStringProc(var t: TTextRec; s: UnicodeString): Pointer;
var
NumberOfCharsWritten, NumOfBytesWritten: DWORD;
begin
Result := #t;
if t.Handle = GetStdHandle(STD_OUTPUT_HANDLE) then
WriteConsole(t.Handle, Pointer(s), Length(s), NumberOfCharsWritten, nil)
else
WriteFile(t.Handle, Pointer(s)^, Length(s)*SizeOf(WideChar), NumOfBytesWritten, nil);
end;
var
UserFile: Text;
begin
AlternateWriteUnicodeStringProc := MyAlternateWriteUnicodeStringProc;
Writeln('АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ');
Readln;
end.
produces this output:
АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ
I'm sceptical of how I've implemented MyAlternateWriteUnicodeStringProc and how it would interact with classic Pascal I/O. However, it appears to behave as desired for output to the console.
The documentation of AlternateWriteUnicodeStringProc currently says, wait for it, ...
Embarcadero Technologies does not currently have any additional information. Please help us document this topic by using the Discussion page!
WriteConsoleW seems to be a quite magical function.
procedure WriteLnToConsoleUsingWriteFile(CP: Cardinal; AEncoding: TEncoding; const S: string);
var
Buffer: TBytes;
NumWritten: Cardinal;
begin
Buffer := AEncoding.GetBytes(S);
// This is a side effect and should be avoided ...
SetConsoleOutputCP(CP);
WriteFile(GetStdHandle(STD_OUTPUT_HANDLE), Buffer[0], Length(Buffer), NumWritten, nil);
WriteLn;
end;
procedure WriteLnToConsoleUsingWriteConsole(const S: string);
var
NumWritten: Cardinal;
begin
WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), PChar(S), Length(S), NumWritten, nil);
WriteLn;
end;
const
Text = 'АБВГДЕЖЅZЗИІКЛМНОПҀРСТȢѸФХѾЦЧШЩЪЫЬѢѤЮѦѪѨѬѠѺѮѰѲѴ';
begin
ReadLn; // Make sure Consolas font is selected
// Works, but changing the console CP is neccessary
WriteLnToConsoleUsingWriteFile(CP_UTF8, TEncoding.UTF8, Text);
// Doesn't work
WriteLnToConsoleUsingWriteFile(1200, TEncoding.Unicode, Text);
// This does and doesn't need the CP anymore
WriteLnToConsoleUsingWriteConsole(Text);
ReadLn;
end.
So in summary:
WriteConsoleW(GetStdHandle(STD_OUTPUT_HANDLE), ...) supports UTF-16.
WriteFile(GetStdHandle(STD_OUTPUT_HANDLE), ...) doesn't support UTF-16.
My guess would be that in order to support different ANSI encodings the classic Pascal I/O uses the WriteFile call.
Also keep in mind that when used on a file instead of the console it has to work as well:
unicode text file output differs between XE2 and Delphi 2009?
That means that blindly using WriteConsole breaks output redirection. If you use WriteConsole you should fall back to WriteFile like this:
var
NumWritten: Cardinal;
Bytes: TBytes;
begin
if not WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), PChar(S), Length(S),
NumWritten, nil) then
begin
Bytes := TEncoding.UTF8.GetBytes(S);
WriteFile(GetStdHandle(STD_OUTPUT_HANDLE), Bytes[0], Length(Bytes),
NumWritten, nil);
end;
WriteLn;
end;
Note that output redirection with any encoding works fine in cmd.exe. It just writes the output stream to the file unchanged.
PowerShell however expects either ANSI output or the correct preamble (/ BOM) has to be included at the start of the output (or the file will be malencoded!). Also PowerShell will always convert the output into UTF-16 with preamble.
MSDN recommends using GetConsoleMode to find out if the standard handle is a console handle, also the BOM is mentioned:
WriteConsole fails if it is used with a standard handle that is
redirected to a file. If an application processes multilingual output
that can be redirected, determine whether the output handle is a
console handle (one method is to call the GetConsoleMode function and
check whether it succeeds). If the handle is a console handle, call
WriteConsole. If the handle is not a console handle, the output is
redirected and you should call WriteFile to perform the I/O. Be sure to
prefix a Unicode plain text file with a byte order mark. For more
information, see Using Byte Order Marks.

How to employ DPROJ <ProjectGUID> within Delphi code?

I want to use a GUID to uniquely identify my Application and to get at this value from within the code. I see that there is a GUID that would be ideal in the DPROJ:
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{D4DB842C-FB4C-481B-8952-77DA04E37102}</ProjectGuid>
Does this get into the exe anywhere, eg as a resource? If not, what is the neatest way of linking in this GUID value into my exe file and reading it in code. The above GUID resides in a dedicated text file and is pasted into the DPROJ with my DprojMaker tool, so I can INCLUDE it in anything you might suggest.
Thanks
AFAIK the <ProjectGUID> is not embedded in the Exe file, but you can create an application to read the project guid and insert as a resource in your exe.
Check this sample app which read a file a create/updates a resource in a exe.
program UpdateResEXE;
{$APPTYPE CONSOLE}
uses
Classes,
Windows,
SysUtils;
//you can improve this method to read the ProjectGUID value directly from the dproj file using XML.
procedure UpdateExeResource(Const Source, ResourceName, ExeFile:string);
var
LStream : TFileStream;
hUpdate : THANDLE;
lpData : Pointer;
cbData : DWORD;
begin
LStream := TFileStream.Create(Source,fmOpenRead or fmShareDenyNone);
try
LStream.Seek(0, soFromBeginning);
cbData:=LStream.Size;
if cbData>0 then
begin
GetMem(lpData,cbData);
try
LStream.Read(lpData^, cbData);
hUpdate:= BeginUpdateResource(PChar(ExeFile), False);
if hUpdate <> 0 then
if UpdateResource(hUpdate, RT_RCDATA, PChar(ResourceName),0,lpData,cbData) then
begin
if not EndUpdateResource(hUpdate,FALSE) then RaiseLastOSError
end
else
RaiseLastOSError
else
RaiseLastOSError;
finally
FreeMem(lpData);
end;
end;
finally
LStream.Free;
end;
end;
begin
try
if ParamCount<>3 then
begin
Writeln('Wrong parameters number');
Halt(1);
end;
Writeln(Format('Adding/Updating resource %s in %s',[ParamStr(2), ParamStr(3)]));
UpdateExeResource( ParamStr(1), ParamStr(2), ParamStr(3));
Writeln('Done');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Now from your app, you can use the Post build events to call this application on this way
"C:\The path where is the tool goes here\UpdateResEXE.exe" "C:\The path of the file which contains the ProjectGUID goes here\Foo.txt" Project_GUID "$(OUTPUTPATH)"
And use like so :
{$APPTYPE CONSOLE}
uses
Windows,
Classes,
System.SysUtils;
function GetProjectGUID : string;
var
RS: TResourceStream;
SS: TStringStream;
begin
RS := TResourceStream.Create(HInstance, 'Project_GUID', RT_RCDATA);
try
SS:=TStringStream.Create;
try
SS.CopyFrom(RS, RS.Size);
Result:= SS.DataString;
finally
SS.Free;
end;
finally
RS.Free;
end;
end;
begin
try
Writeln(Format('Project GUID %s',[GetProjectGUID]));
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
readln;
end.
Why not just hard-code your own GUID inside your code itself? The Code Editor has a CTRL+SHIFT+G keyboard shortcut for generating a new GUID string at the current active line of code. You can tweak that declaration into a constant variable for your code to use as needed, eg:
const
MyGuid: TGUID = '{04573E0E-DE08-4796-A5BB-E5F1F17D51F7}';

Downloading a file in delphi from a trigger and capturing the file name

I have a url of a website. It looks something like this: http://www.example.com/downloads/file/4789/download?
I would like to save the file to my system, but I do not know how to get the file name of the download triggered by the URL in my example. Some files are pdf others are doc and rtf etc.
If someone can please point me in a direction of the filename problem and also what components to use, I would really appreciate it.
to get the filename from a url you can retrieve the HEAD information and check Content Disposition header field. For this task you can use the TIdHTTP indy component. if the Content Disposition doesn't have the file name you can try parsing the url.
Try this sample .
{$APPTYPE CONSOLE}
{$R *.res}
uses
IdURI,
IdHttp,
SysUtils;
function GetRemoteFileName (const URI: string) : string;
var
LHttp: TIdHTTP;
begin
LHttp := TIdHTTP.Create(nil);
try
LHttp.Head(URI);
Result:= LHTTP.Response.RawHeaders.Params['Content-Disposition', 'filename'];
if Result = '' then
with TIdURI.Create(URI) do
try
Result := Document;
finally
Free;
end;
finally
LHttp.Free;
end;
end;
begin
try
Writeln(GetRemoteFileName('http://dl.dropbox.com/u/12733424/Blog/Delphi%20Wmi%20Code%20Creator/Setup_WmiDelphiCodeCreator.exe'));
Writeln(GetRemoteFileName('http://studiostyl.es/settings/downloadScheme/1305'));
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.

Save a IXMLDOMDocument3 to xml-file in runtime with Delphi 2007

If I would like to save a IXMLDOMDocument3 in runtime to a file on my harddrive, what is the syntax for that?
E.g. like IXMLDOMDocument3.save('c:\test.xml')
Or is it even possible?
Best regards!
the sample code below demonstrates how to load and save IXMLDomDocument3 XML at runtime. It uses msxml header file from Delphi-2010. IXMLDomDocument3 inherits from IXMLDomDocument and has Save method (as you wrote in your question). If method parameter is a string, then it specifies file name (it creates or replaces target file).
program Project3;
{$APPTYPE CONSOLE}
uses SysUtils, msxml, comObj, activex;
procedure LoadAndSaveXML(LoadFile, SaveFile : string);
var xml : IXMLDOMDocument3;
tn : IXMLDOMElement;
begin
xml := CreateComObject(CLASS_DOMDocument60) as IXMLDOMDocument3;
xml.load(LoadFile);
xml.save(SaveFile);
end;
begin
try
CoInitialize(nil);
try
LoadAndSaveXML('D:\in.xml', 'D:\out.xml');
finally
CoUninitialize();
end;
except
on E: Exception do begin
Writeln(E.ClassName, ': ', E.Message);
readln;
end;
end;
end.

Resources