How can I remove all CRLF from a from a Base64 text file to make its content only on one line?
The following code uses a function, NoLineFeed, and a combination of TStringStream and AnsiString but still some CRLF are present (near the end of the file) after the content of the file have been processed by NoLineFeed.
function NoLineFeed was excerpted from a StackOverflow post by Arnaud Bouchez: Make String into only 1 line
var
StringVal: AnsiString;
XmlFile: TStringStream;
begin
XmlFile := TStringStream.Create;
try
XmlFile.LoadFromFile('file.txt');
StringVal := NoLineFeed(XmlFile.DataString);
if Length(StringVal) > 0 then
XmlFile.Write(StringVal[1], Length(StringVal));
XmlFile.SaveToFile('converted_file.txt');
finally
XmlFile.Free;
end;
end;
{ Arnaud Bouchez }
function NoLineFeed(const s: string): string;
var i: integer;
begin
result := s;
for i := length(result) downto 1 do
if ord(result[i])<32 then
if (i>1) and (ord(result[i-1])<=32) then
delete(result,i,1) else
result[i] := ' ';
end;
An alternative approach using a TStringList:
var
lst: TStringList;
begin
lst := TStringList.Create;
try
lst.LoadFromFile('file.txt');
lst.LineBreak := ' ';
lst.SaveToFile('converted_file.txt');
finally
lst.Free;
end;
end;
Linebreaks and cariage return doesn't come always together, linebreaks sometimes come alone without cariage return and this may be the left linebreaks you have , just remove #13 characters and #10 characters separately will solve the problem ,try this code:
var
StringVal: AnsiString;
XmlFile: TStringStream;
begin
XmlFile := TStringStream.Create;
try
XmlFile.LoadFromFile('file.txt');
StringVal := StringReplace(XmlFile.DataString, #13, ' ', [rfReplaceAll]);
StringVal := StringReplace(StringVal, #10, '', [rfReplaceAll]);
if Length(StringVal) > 0 then
XmlFile.Write(StringVal[1], Length(StringVal));
XmlFile.SaveToFile('converted_file.txt');
finally
XmlFile.Free;
end;
end;
Related
i want to send emoji with indy 9.00.10 on delphi 7. i use tnt VCL Controls .
i found this url http://apps.timwhitlock.info/emoji/tables/unicode for unicode and bytes code.
how to convert this codes to delphi Constants for Send with indy.
i use this delphi code for send message to telegram bot:
procedure TBotThread.SendMessage(ChatID:String; Text : WideString;
parse_mode:string;disable_notification:boolean);
Var
Stream: TStringStream;
Params: TIdMultipartFormDataStream;
//Text : WideString;
msg : WideString;
Src : string;
LHandler: TIdSSLIOHandlerSocket;
begin
try
try
if FShowBotLink then
Text := Text + LineBreak + FBotUser;
msg := '/sendmessage';
Stream := TStringStream.Create('');
Params := TIdMultipartFormDataStream.Create;
Params.AddFormField('chat_id',ChatID);
if parse_mode <> '' then
Params.AddFormField('parse_mode',parse_mode);
if disable_notification then
Params.AddFormField('disable_notification','true')
else
Params.AddFormField('disable_notification','false');
Params.AddFormField('disable_web_page_preview','true');
Params.AddFormField('text',UTF8Encode(Text));
LHandler := TIdSSLIOHandlerSocket.Create(nil);
FidHttpSend.ReadTimeout := 30000;
FidHttpSend.IOHandler:=LHandler;
LHandler.SSLOptions.Method := sslvTLSv1;
LHandler.SSLOptions.Mode := sslmUnassigned;
FidHttpSend.HandleRedirects := true;
FidHttpSend.Post(BaseUrl + API + msg, Params, Stream);
finally
Params.Free;
Stream.Free;
ENd;
except
on E: EIdHTTPProtocolException do
begin
if E.ReplyErrorCode = 403 then
begin
WriteToLog('Bot was blocked by the user');
end;
end;
end;
end;
bytes sample for emojies:
AERIAL_TRAMWAY = '\xf0\x9f\x9a\xa1';
AIRPLANE = '\xe2\x9c\x88';
ALARM_CLOCK = '\xe2\x8f\xb0';
ALIEN_MONSTER = '\xf0\x9f\x91\xbe';
sorry for bad english!!!
The Telegram Bot API supports several forms of input:
We support GET and POST HTTP methods. We support four ways of passing parameters in Bot API requests:
URL query string
application/x-www-form-urlencoded
application/json (except for uploading files)
multipart/form-data (use to upload files)
You are using the last option.
Indy 9 does not support Delphi 2009+ or Unicode. All uses of string are assumed to be AnsiString, which is the case in Delphi 7. Any AnsiString you add to TIdMultipartFormDataStream or TStrings, even a UTF-8 encoded one, will be transmitted as-is by TIdHTTP. However, there is no option to specify to the server that the string data is actually using UTF-8 as a charset. But, according to the docs:
All queries must be made using UTF-8.
So not specifying an explicit charset might not be problem.
If you still have problems with multipart/form-data, then consider using application/x-www-form-urlencoded (use TIdHTTP.Post(TStrings)) or application/json (use TIdHTTP.Post(TStream)) instead:
procedure TBotThread.SendMessage(ChatID: String; Text: WideString; parse_mode: string; disable_notification: boolean);
var
Params: TStringList;
LHandler: TIdSSLIOHandlerSocket;
begin
if FShowBotLink then
Text := Text + LineBreak + FBotUser;
Params := TStringList.Create;
try
Params.Add('chat_id=' + UTF8Encode(ChatID));
if parse_mode <> '' then
Params.Add('parse_mode=' + UTF8Encode(parse_mode));
if disable_notification then
Params.Add('disable_notification=true')
else
Params.Add('disable_notification=false');
Params.Add('disable_web_page_preview=true');
Params.Add('text=' + UTF8Encode(Text));
LHandler := TIdSSLIOHandlerSocket.Create(nil);
try
LHandler.SSLOptions.Method := sslvTLSv1;
LHandler.SSLOptions.Mode := sslmClient;
FidHttpSend.HandleRedirects := true;
FidHttpSend.ReadTimeout := 30000;
FidHttpSend.IOHandler := LHandler;
try
try
FidHttpSend.Post(BaseUrl + API + '/sendmessage', Params, TStream(nil));
except
on E: EIdHTTPProtocolException do
begin
if E.ReplyErrorCode = 403 then
begin
WriteToLog('Bot was blocked by the user');
end;
end;
end;
finally
FidHttpSend.IOHandler := nil;
end;
finally
LHandler.Free;
end;
finally
Params.Free;
end;
end;
procedure TBotThread.SendMessage(ChatID: String; Text: WideString; parse_mode: string; disable_notification: boolean);
var
Params: TStringStream;
LHandler: TIdSSLIOHandlerSocket;
function JsonEncode(const wStr: WideString): string;
var
I: Integer;
Ch: WideChar;
begin
// JSON uses UTF-16 text, so no need to encode to UTF-8...
Result := '';
for I := 1 to Length(wStr) do
begin
Ch := wStr[i];
case Ch of
#8: Result := Result + '\b';
#9: Result := Result + '\t';
#10: Result := Result + '\n';
#12: Result := Result + '\f';
#13: Result := Result + '\r';
'"': Result := Result + '\"';
'\': Result := Result + '\\';
'/': Result := Result + '\/';
else
if (Ord(Ch) >= 32) and (Ord(Ch) <= 126) then
Result := Result + AnsiChar(Ord(wStr[i]))
else
Result := Result + '\u' + IntToHex(Ord(wStr[i]), 4);
end;
end;
end;
begin
if FShowBotLink then
Text := Text + LineBreak + FBotUser;
Params := TStringStream.Create('');
try
Params.WriteString('{');
Params.WriteString('chat_id: "' + JsonEncode(ChatID) + '",');
if parse_mode <> '' then
Params.WriteString('parse_mode: "' + JsonEncode(parse_mode) + '",')
if disable_notification then
Params.WriteString('disable_notification: True,')
else
Params.WriteString('disable_notification: False,');
Params.WriteString('disable_web_page_preview: True,');
Params.WriteString('text: "' + JsonEncode(Text) + '"');
Params.WriteString('}');
Params.Position := 0;
LHandler := TIdSSLIOHandlerSocket.Create(nil);
try
LHandler.SSLOptions.Method := sslvTLSv1;
LHandler.SSLOptions.Mode := sslmClient;
FidHttpSend.HandleRedirects := true;
FidHttpSend.ReadTimeout := 30000;
FidHttpSend.IOHandler := LHandler;
try
try
FidHttpSend.Request.ContentType := 'application/json';
FidHttpSend.Post(BaseUrl + API + '/sendmessage', Params, TStream(nil));
except
on E: EIdHTTPProtocolException do
begin
if E.ReplyErrorCode = 403 then
begin
WriteToLog('Bot was blocked by the user');
end;
end;
end;
finally
FidHttpSend.IOHandler := nil;
end;
finally
LHandler.Free;
end;
finally
Params.Free;
end;
end;
That being said, your function's Text parameter is a WideString, which uses UTF-16, so you should be able to send any Unicode text, including emojis. If you are trying to generate text in your code, just make sure you UTF-16 encode any non-ASCII characters correctly. For example, codepoint U+1F601 GRINNING FACE WITH SMILING EYES is wide chars $D83D $DE01 in UTF-16:
var
Text: WideString;
Text := 'hi ' + #$D83D#$DE01; // 'hi π'
SendMessage('#channel', Text, 'Markup', False);
Alternatively, you can use HTML in your text messages, so you can encode non-ASCII characters using numerical HTML entities. According to the docs:
All numerical HTML entities are supported.
Codepoint U+1F601 is numeric entity $#128513; in HTML:
var
Text: WideString;
Text := 'hi $#128513;'; // 'hi π'
SendMessage('#channel', Text, 'HTML', False);
I have an app that needs to do heavy text manipulation in a TStringList. Basically i need to split text by a delimiter ; for instance, if i have a singe line with 1000 chars and this delimiter occurs 3 times in this line, then i need to split it in 3 lines. The delimiter can contain more than one char, it can be a tag like '[test]' for example.
I've wrote two functions to do this task with 2 different approaches, but both are slow in big amounts of text (more then 2mbytes usually).
How can i achieve this goal in a faster way ?
Here are both functions, both receive 2 paramaters : 'lines' which is the original tstringlist and 'q' which is the delimiter.
function splitlines(lines : tstringlist; q: string) : integer;
var
s, aux, ant : string;
i,j : integer;
flag : boolean;
m2 : tstringlist;
begin
try
m2 := tstringlist.create;
m2.BeginUpdate;
result := 0;
for i := 0 to lines.count-1 do
begin
s := lines[i];
for j := 1 to length(s) do
begin
flag := lowercase(copy(s,j,length(q))) = lowercase(q);
if flag then
begin
inc(result);
m2.add(aux);
aux := s[j];
end
else
aux := aux + s[j];
end;
m2.add(aux);
aux := '';
end;
m2.EndUpdate;
lines.text := m2.text;
finally
m2.free;
end;
end;
function splitLines2(lines : tstringlist; q: string) : integer;
var
aux, p : string;
i : integer;
flag : boolean;
begin
//maux1 and maux2 are already instanced in the parent class
try
maux2.text := lines.text;
p := '';
i := 0;
flag := false;
maux1.BeginUpdate;
maux2.BeginUpdate;
while (pos(lowercase(q),lowercase(maux2.text)) > 0) and (i < 5000) do
begin
flag := true;
aux := p+copy(maux2.text,1,pos(lowercase(q),lowercase(maux2.text))-1);
maux1.add(aux);
maux2.text := copy(maux2.text,pos(lowercase(q),lowercase(maux2.text)),length(maux2.text));
p := copy(maux2.text,1,1);
maux2.text := copy(maux2.text,2,length(maux2.text));
inc(i);
end;
finally
result := i;
maux1.EndUpdate;
maux2.EndUpdate;
if flag then
begin
maux1.add(p+maux2.text);
lines.text := maux1.text;
end;
end;
end;
I've not tested the speed, but for academic purposes, here's an easy way to split the strings:
myStringList.Text :=
StringReplace(myStringList.Text, myDelimiter, #13#10, [rfReplaceAll]);
// Use [rfReplaceAll, rfIgnoreCase] if you want to ignore case
When you set the Text property of TStringList, it parses on new lines and splits there, so converting to a string, replacing the delimiter with new lines, then assigning it back to the Text property works.
The problems with your code (at least second approach) are
You are constantly using lowecase which is slow if called so many times
If I saw correctly you are copying the whole remaining text back to the original source. This is sure to be extra slow for large strings (eg files)
I have a tokenizer in my library. Its not the fastest or best but it should do (you can get it from Cromis Library, just use the units Cromis.StringUtils and Cromis.Unicode):
type
TTokens = array of ustring;
TTextTokenizer = class
private
FTokens: TTokens;
FDelimiters: array of ustring;
public
constructor Create;
procedure Tokenize(const Text: ustring);
procedure AddDelimiters(const Delimiters: array of ustring);
property Tokens: TTokens read FTokens;
end;
{ TTextTokenizer }
procedure TTextTokenizer.AddDelimiters(const Delimiters: array of ustring);
var
I: Integer;
begin
if Length(Delimiters) > 0 then
begin
SetLength(FDelimiters, Length(Delimiters));
for I := 0 to Length(Delimiters) - 1 do
FDelimiters[I] := Delimiters[I];
end;
end;
constructor TTextTokenizer.Create;
begin
SetLength(FTokens, 0);
SetLength(FDelimiters, 0);
end;
procedure TTextTokenizer.Tokenize(const Text: ustring);
var
I, K: Integer;
Counter: Integer;
NewToken: ustring;
Position: Integer;
CurrToken: ustring;
begin
SetLength(FTokens, 100);
CurrToken := '';
Counter := 0;
for I := 1 to Length(Text) do
begin
CurrToken := CurrToken + Text[I];
for K := 0 to Length(FDelimiters) - 1 do
begin
Position := Pos(FDelimiters[K], CurrToken);
if Position > 0 then
begin
NewToken := Copy(CurrToken, 1, Position - 1);
if NewToken <> '' then
begin
if Counter > Length(FTokens) then
SetLength(FTokens, Length(FTokens) * 2);
FTokens[Counter] := Trim(NewToken);
Inc(Counter)
end;
CurrToken := '';
end;
end;
end;
if CurrToken <> '' then
begin
if Counter > Length(FTokens) then
SetLength(FTokens, Length(FTokens) * 2);
FTokens[Counter] := Trim(CurrToken);
Inc(Counter)
end;
SetLength(FTokens, Counter);
end;
How about just using StrTokens from the JCL library
procedure StrTokens(const S: string; const List: TStrings);
It's open source
http://sourceforge.net/projects/jcl/
As an additional option, you can use regular expressions. Recent versions of Delphi (XE4 and XE5) come with built in regular expression support; older versions can find a free regex library download (zip file) at Regular-Expressions.info.
For the built-in regex support (uses the generic TArray<string>):
var
RegexObj: TRegEx;
SplitArray: TArray<string>;
begin
SplitArray := nil;
try
RegexObj := TRegEx.Create('\[test\]'); // Your sample expression. Replace with q
SplitArray := RegexObj.Split(Lines, 0);
except
on E: ERegularExpressionError do begin
// Syntax error in the regular expression
end;
end;
// Use SplitArray
end;
For using TPerlRegEx in earlier Delphi versions:
var
Regex: TPerlRegEx;
m2: TStringList;
begin
m2 := TStringList.Create;
try
Regex := TPerlRegEx.Create;
try
Regex.RegEx := '\[test\]'; // Using your sample expression - replace with q
Regex.Options := [];
Regex.State := [preNotEmpty];
Regex.Subject := Lines.Text;
Regex.SplitCapture(m2, 0);
finally
Regex.Free;
end;
// Work with m2
finally
m2.Free;
end;
end;
(For those unaware, the \ in the sample expression used are because the [] characters are meaningful in regular expressions and need to be escaped to be used in the regular expression text. Typically, they're not required in the text.)
This program raises an I/O 104 error on EoF when first entering the while loop.
The purpose of the program is to look up if a username is already taken. The existing usernames are stored in a text file.
procedure TForm1.btnRegisterClick(Sender: TObject);
begin
sCUser := edtUserName.Text;
AssignFile(tNames, 'Names.txt');
begin
try
Reset(tNames);
except
ShowMessage('File not found');
Exit;
end;
end;
rewrite(tNames);
while not EoF(tNames) do // I get a I/O 104 Error here `
begin
Readln(tNames, sLine);
iPosComme := Pos(',', sLine);
sUser := Copy(sLine, 1, iPosComme - 1);
Delete(sLine, 1, iPosComme - 1);
if sCUser = sUser then begin
ShowMessage('Username taken');
end
else
begin
rewrite(tNames);
Writeln(tNames, sCUser + ',' + '0');
CloseFile(tNames);
end;
end;
end;
Remove the call to Rewrite()before Eof(). Even if you were not getting an IO error, your code would still fail because Rewrite() closes the file you opened with Reset() and then it creates a new bank file, so Eof() would always be True.
Update: error 104 is file not open for input, which means Reset() is not opening the file but is not raising an exception (which sounds like an RTL bug if Eof() is raising an exception, indicating that {I+} is active).
In any case, using AssignFile() and related routines is the old way to do file I/O. You should use newer techniques, like FileOpen() with FileRead(), TFileStream with TStreamReader, TStringList, etc...
Update: your loop logic is wrong. You are comparing only the first line. If it does not match the user, you are wiping out the file, writing the user to a new file, closing the file, and then continuing the loop. EoF() will then fail at that point. You need to rewrite your loop to the following:
procedure TForm1.btnRegisterClick(Sender: TObject
var
SCUser, sUser: String;
tNames: TextFile;
iPosComme: Integer;
Found: Boolean;
begin
sCUser := edtUserName.Text;
AssignFile(tNames,'Names.txt');
try
Reset(tNames);
except
ShowMessage('File not found');
Exit;
end;
try
Found := False;
while not EoF(tNames) do
begin
Readln(tNames,sLine);
iPosComme := Pos(',', sLine);
sUser := Copy(sLine ,1,iPosComme -1);
if sCUser = sUser then
begin
ShowMessage('Username taken') ;
Found := True;
Break;
end;
end;
if not Found then
Writeln(tNames,sCUser + ',0');
finally
CloseFile(tNames);
end;
end;
For the sake of completeness, this Version works for me, but it is hard to guess what the code is intended to do. Especially the while loop seems a bit displaced, since the file will contain exactly one line after the rewrite-case has ben hit once.
program wtf;
{$APPTYPE CONSOLE}
{$I+}
uses
SysUtils;
procedure Sample( sCUser : string);
var sUser, sLine : string;
iPosComme : Integer;
tnames : textfile;
begin
AssignFile(tNames,'Names.txt');
try
Reset(tNames);
except
Writeln('File not found');
Exit;
end;
while not EoF(tNames) do
begin
Readln(tNames,sLine);
iPosComme := Pos(',', sLine);
sUser := Copy(sLine ,1,iPosComme -1);
Delete( sLine,1, iPosComme -1);
if sCuser = sUser then begin
Writeln('Username taken') ;
end
else begin
Rewrite(tNames);
Writeln(tNames,sCUser + ',' + '0');
CloseFile(tNames);
Break; // file has been overwritten and closed
end;
end;
end;
begin
try
Sample('foobar');
except
on E: Exception do Writeln(E.ClassName, ': ', E.Message);
end;
end.
I wrote a version of this method that uses the newer TStreamReader and TStreamWriter classes.
This won't work with Delphi 7 of course, it's just to show how this could be done in newer versions of Delphi.
The code was heavily inspired by Remys answer.
procedure TForm1.btnRegisterClick(Sender: TObject);
var
Stream: TStream;
Reader: TStreamReader;
Writer: TStreamWriter;
Columns: TStringList;
UserName: string;
Found: Boolean;
FileName: string;
Encoding: TEncoding;
begin
FileName := ExpandFileName('Names.txt'); // An absolute path would be even better
UserName := edtUsername.Text;
Found := False;
Encoding := TEncoding.Default; // or another encoding, e.g. TEncoding.Unicode for Unicode
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
Reader := TStreamReader.Create(Stream, Encoding);
try
Columns := TStringList.Create;
try
Columns.Delimiter := ',';
Columns.StrictDelimiter := True; // or False, depending on the file format
while not Reader.EndOfStream do
begin
Columns.DelimitedText := Reader.ReadLine;
if Columns.Count > 0 then
begin
if AnsiSameStr(Columns[0], UserName) then // or AnsiSameText if UserName is not case-sensitive
begin
ShowMessage('Username taken') ;
Found := True;
Break;
end;
end;
end;
finally
Columns.Free;
end;
finally
Reader.Free;
end;
finally
Stream.Free;
end;
if not Found then
begin
Writer := TStreamWriter.Create(FileName, True, Encoding);
try
// Warning: This will cause problems when the file does not end with a new line
Writer.WriteLine(UserName + ',0');
finally
Writer.Free;
end;
end;
end;
If performance and memory usage are not a concern:
procedure TForm1.btnRegisterClick(Sender: TObject);
var
Rows: TStringList;
Columns: TStringList;
UserName: string;
Found: Boolean;
FileName: string;
Encoding: TEncoding;
Row: string;
begin
FileName := ExpandFileName('Names.txt'); // An absolute path would be even better
UserName := edtUsername.Text;
Found := False;
Encoding := TEncoding.Default; // or another encoding, e.g. TEncoding.Unicode for Unicode
Rows := TStringList.Create;
try
Rows.LoadFromFile(FileName, Encoding);
Columns := TStringList.Create;
try
Columns.Delimiter := ',';
Columns.StrictDelimiter := True; // or False, depending on the file format
for Row in Rows do
begin
Columns.DelimitedText := Row;
if Columns.Count > 0 then
begin
if AnsiSameStr(Columns[0], UserName) then // or AnsiSameText if UserName is not case-sensitive
begin
ShowMessage('Username taken') ;
Found := True;
Break;
end;
end;
end;
finally
Columns.Free;
end;
if not Found then
begin
Rows.Add(UserName + ',0');
Rows.SaveToFile(FileName, Encoding);
end;
finally
Rows.Free;
end;
end;
This solution can be adapted to Delphi 7 by removing the Encoding variable.
If it's part of a bigger database it should be stored in a real database management system rather than a text file.
I want to export content of a TQuery to a CSV file without using a 3d part component(Delphi 7). From my knowledge this can not be accomplished with Delphi standard components.
My solution was to save the content in a StringList with a CSV format, and save it to a file.
Is there any comfortable solution?
PS:I don't want to use JvCsvDataSet or any component. Question is: can this be accomplished only with Delphi 7 or higher standard components?
Thank you in advance!
Of course it can.
You just have to do the work to properly output the CSV content (quoting properly, handling embedded quotes and commas, etc.). You can easily write the output using TFileStream, and get the data using the TQuery.Fields and TQuery.FieldCount properly.
I'll leave the fancy CSV quoting and special handling to you. This will take care of the easy part:
var
Stream: TFileStream;
i: Integer;
OutLine: string;
sTemp: string;
begin
Stream := TFileStream.Create('C:\Data\YourFile.csv', fmCreate);
try
while not Query1.Eof do
begin
// You'll need to add your special handling here where OutLine is built
OutLine := '';
for i := 0 to Query.FieldCount - 1 do
begin
sTemp := Query.Fields[i].AsString;
// Special handling to sTemp here
OutLine := OutLine + sTemp + ',';
end;
// Remove final unnecessary ','
SetLength(OutLine, Length(OutLine) - 1);
// Write line to file
Stream.Write(OutLine[1], Length(OutLine) * SizeOf(Char));
// Write line ending
Stream.Write(sLineBreak, Length(sLineBreak));
Query1.Next;
end;
finally
Stream.Free; // Saves the file
end;
end;
The original question asked for a solution using a StringList. So it would be something more like this. It will work with any TDataSet, not just a TQuery.
procedure WriteDataSetToCSV(DataSet: TDataSet, FileName: String);
var
List: TStringList;
S: String;
I: Integer;
begin
List := TStringList.Create;
try
DataSet.First;
while not DataSet.Eof do
begin
S := '';
for I := 0 to DataSet.FieldCount - 1 do
begin
if S > '' then
S := S + ',';
S := S + '"' + DataSet.Fields[I].AsString + '"';
end;
List.Add(S);
DataSet.Next;
end;
finally
List.SaveToFile(FileName);
List.Free;
end;
end;
You can add options to change the delimiter type or whatever.
This is like the Rob McDonell solution but with some enhancements: header, escape chars, enclosure only when required, and ";" separator.
You can easily disable this enhancements if not required.
procedure SaveToCSV(DataSet: TDataSet; FileName: String);
const
Delimiter: Char = ';'; // In order to be automatically recognized in Microsoft Excel use ";", not ","
Enclosure: Char = '"';
var
List: TStringList;
S: String;
I: Integer;
function EscapeString(s: string): string;
var
i: Integer;
begin
Result := StringReplace(s,Enclosure,Enclosure+Enclosure,[rfReplaceAll]);
if (Pos(Delimiter,s) > 0) OR (Pos(Enclosure,s) > 0) then // Comment this line for enclosure in every fields
Result := Enclosure+Result+Enclosure;
end;
procedure AddHeader;
var
I: Integer;
begin
S := '';
for I := 0 to DataSet.FieldCount - 1 do begin
if S > '' then
S := S + Delimiter;
S := S + EscapeString(DataSet.Fields[I].FieldName);
end;
List.Add(S);
end;
procedure AddRecord;
var
I: Integer;
begin
S := '';
for I := 0 to DataSet.FieldCount - 1 do begin
if S > '' then
S := S + Delimiter;
S := S + EscapeString(DataSet.Fields[I].AsString);
end;
List.Add(S);
end;
begin
List := TStringList.Create;
try
DataSet.DisableControls;
DataSet.First;
AddHeader; // Comment if header not required
while not DataSet.Eof do begin
AddRecord;
DataSet.Next;
end;
finally
List.SaveToFile(FileName);
DataSet.First;
DataSet.EnableControls;
List.Free;
end;
end;
Delphi does not provide any built-in access to .csv data.
However, following the VCL TXMLTransform paradigm, I wrote a TCsvTransform class helper that will translate a .csv structure to /from a TClientDataSet.
As for the initial question that was to export a TQuery to .csv, a simple TDataSetProvider will make the link between TQuery and TClientDataSet.
For more details about TCsvTransform, cf http://didier.cabale.free.fr/delphi.htm#uCsvTransform
How is it possible to write to Delphi files, oem encoding?
How do you set the encoding? as string encoding is set by
setCodePage(RawBytes;Word;boolean);
You need the Windows API function CharToOemBuff().
EDIT
Inspired by #Free Consulting, the above API is what you would use in an older non-Unicode Delphi.
As #Free Consulting correctly points out, the new versions of Delphi offer extensive code page translation services. As a more modern variant of the old-style Pascal I/O, you could use a TStringList saved with a specified encoding.
Encoding := TEncoding.GetEncoding(GetOEMCP);
Try
StringList.SaveToFile('test.txt', Encoding);
Finally
Encoding.Free;
End;
I have a wrote a function that does that. It is no pretty, but it works.
function SetFileContent(aFileName: string; aFileContent: string; out aErrorMsg: string; aEncoding: TEncoding = nil; aRecreateFile: Boolean = True): Boolean;
var
vStream: TFileStream;
vCurEncoding: TEncoding;
vPreamble, vContent: TBytes;
vOffSet: Integer;
procedure _SetFileContent(aNewFile: Boolean);
begin
if aNewFile then begin
vStream := TFileStream.Create(aFileName, fmCreate);
try
vPreamble := aEncoding.GetPreamble;
If Length(vPreamble) > 0 then begin
vStream.WriteBuffer(Pointer(vPreamble)^, Length(vPreamble));
end;
vStream.WriteBuffer(Pointer(vContent)^, Length(vContent));
finally
vStream.Free;
End;
end
else begin
vStream := TFileStream.Create(aFileName, fmOpenWrite);
try
vStream.Position := vStream.Size;
vStream.WriteBuffer(Pointer(vContent)^, Length(vContent));
finally
vStream.Free;
end;
end;
end;
begin
Result := True;
try
vContent := BytesOf(aFileContent);
vCurEncoding := nil;
if aEncoding = nil then begin
aEncoding := TEncoding.Default;
end;
vOffSet := TEncoding.GetBufferEncoding(vContent, vCurEncoding);
if (vCurEncoding <> aEncoding) and aRecreateFile then begin
vContent := TEncoding.Convert(vCurEncoding, aEncoding, vContent, vOffSet, Length(vContent) - vOffSet);
end;
if FileExists(aFileName) then begin
if aRecreateFile then begin
_SetFileContent(True);
end
else begin
_SetFileContent(False);
end;
end
else begin
_SetFileContent(True);
end;
except
on E: Exception do begin
Result := False;
aErrorMsg := 'There was an error while trying to write the string ' + aFileContent + ' in the file ' + aFileName + '. Error: ' + E.Message;
end;
end;
end;
TStringList.SaveToFile() has a TEncoding parameter, you can use TEncoding.GetEncoding() to get an encoding object for any installed codepage, so you can specify the return value of GetOEMCP() for that. Or use TFileStream or FileWrite() to write to a file manually, and then use TEncoding.GetBytes() to encode String values during your writing.
With ease. It depends on file I/O method to be used. Example of one:
procedure TForm11.FormCreate(Sender: TObject);
var
S: string;
begin
DefaultSystemCodePage := GetOEMCP();
S := 'ΠΡΠ»ΠΈ ΠΈΡΠΏΠΎΠ»ΡΠ·ΡΠ΅ΡΡ ΠΌΠΎΠΉ ΠΊΠΎΠ΄, ΡΠΎ ΡΡ Π΄ΠΎΠ»ΠΆΠ΅Π½ ΠΌΠ½Π΅ ΠΏΠΎΡΠΊΡ';
AssignFile(Output, 'license.txt');
Rewrite(Output);
Write(Output, S); // converts to single byte here
CloseFile(Output);
Application.Terminate;
end;
NO bum rap about Pascal I/O, please :-P