Send email with attachment in Delphi - html

How do I send an attachment in an HTML formatted email?
I managed to send an email using stmp.gmail.com in HTML format, but my email has an attachment. The attachment gets converted to a string, but I need it to be in the original file format.
Code:
with FIdSmtp do
begin
// Configure IdSMTP
end;
FIdMessage.Clear;
FIdMessage.MessageParts.Clear;
FIdMessage.From.Address := 'EmailRemetente';
FIdMessage.From.Name := 'Apelido';
FIdMessage.Subject := 'Assunto';
FIdMessage.Body.Text := 'Mensagem';
FIdMessage.Recipients.EMailAddresses := 'aEmailDestinatario'; //email destino
FIdMessage.BccList.EMailAddresses := StringReplace(Trim(BCCList.Text),#13#10,',',[rfReplaceAll]);
FIdMessage.ccList.EMailAddresses := StringReplace(Trim(CCList.Text),#13#10,',',[rfReplaceAll]);
FIdMessage.ContentType := 'text/html'; // set html format
_Anexo := TStringList.Create;
try
_Anexo.Text := aAnexos;
for i := 0 to _Anexo.Count - 1 do
TIdAttachmentFile.Create(FIdMessage.MessageParts,_Anexo.Strings[i]);
finally
_Anexo.Free
end;
FIdSmtp.Send(FIdMessage);
Can someone help me?

Read my blog on Indy's website, I discussed this subject in some detail:
HTML Messages
New HTML Message Builder class
With that in mind, try this:
FIdMessage.Clear;
FIdMessage.From.Address := 'EmailRemetente';
FIdMessage.From.Name := 'Apelido';
FIdMessage.Subject := 'Assunto';
FIdMessage.Recipients.EMailAddresses := 'aEmailDestinatario';
FIdMessage.BccList.EMailAddresses := StringReplace(Trim(BCCList.Text),sLineBreak,',',[rfReplaceAll]);
FIdMessage.ccList.EMailAddresses := StringReplace(Trim(CCList.Text),sLineBreak,',',[rfReplaceAll]);
FIdMessage.ContentType := 'multipart/mixed';
with TIdText.Create(FIdMessage.MessageParts, nil) do
begin
ContentType := 'text/html';
Body.Text := 'Mensagem';
end;
_Anexo := TStringList.Create;
try
_Anexo.Text := aAnexos;
for i := 0 to _Anexo.Count - 1 do
TIdAttachmentFile.Create(FIdMessage.MessageParts, _Anexo.Strings[i]);
finally
_Anexo.Free
end;
Or this:
FIdMessage.Clear;
with TIdMessageBuilderHtml.Create do
try
Subject := 'Assunto';
Html.Text := 'Mensagem';
_Anexo := TStringList.Create;
try
_Anexo.Text := aAnexos;
for i := 0 to _Anexo.Count - 1 do
Attachments.Add(_Anexo.Strings[i]);
finally
_Anexo.Free
end;
FillMessage(FIdMessage);
finally
Free;
end;
FIdMessage.From.Address := 'EmailRemetente';
FIdMessage.From.Name := 'Apelido';
FIdMessage.Recipients.EMailAddresses := 'aEmailDestinatario';
FIdMessage.BccList.EMailAddresses := StringReplace(Trim(BCCList.Text),sLineBreak,',',[rfReplaceAll]);
FIdMessage.ccList.EMailAddresses := StringReplace(Trim(CCList.Text),sLineBreak,',',[rfReplaceAll]);

Related

Function in Go to execute select query on database and return json output

I am writing a function in Go to execute select query on database.
Input: String e.g. "Select id, name, age from sometable"
This query changes everytime.
Output: Output of select query in json format.
Sample Expected output: {"Data":[{"id":1,"name":"abc", "age":40},{"id":2,"name":"xyz", "age":45}]}
Sample Actual output: {"Data":[[1,"abc",40],[2,"xyz",45]]}
Instead of i.e. column_name:value, I get only values.
How do I get the expected output?
func executeSQL(queryStr string) []byte {
connString := createConnectString()
conn, err := sql.Open("mssql", connString)
if err != nil {
log.Fatal("Error while opening database connection:", err.Error())
}
defer conn.Close()
rows, err := conn.Query(queryStr)
if err != nil {
log.Fatal("Query failed:", err.Error())
}
defer rows.Close()
columns, _ := rows.Columns()
count := len(columns)
var v struct {
Data []interface{} // `json:"data"`
}
for rows.Next() {
values := make([]interface{}, count)
valuePtrs := make([]interface{}, count)
for i, _ := range columns {
valuePtrs[i] = &values[i]
}
if err := rows.Scan(valuePtrs...); err != nil {
log.Fatal(err)
}
v.Data = append(v.Data, values)
}
jsonMsg, err := json.Marshal(v)
return jsonMsg
}
Got the solution. Here is what I did.
func executeSQL(queryStr string) []byte {
connString := createConnectString()
conn, err := sql.Open("mssql", connString)
if err != nil {
log.Fatal("Error while opening database connection:", err.Error())
}
defer conn.Close()
rows, err := conn.Query(queryStr)
if err != nil {
log.Fatal("Query failed:", err.Error())
}
defer rows.Close()
columns, _ := rows.Columns()
count := len(columns)
var v struct {
Data []interface{} // `json:"data"`
}
for rows.Next() {
values := make([]interface{}, count)
valuePtrs := make([]interface{}, count)
for i, _ := range columns {
valuePtrs[i] = &values[i]
}
if err := rows.Scan(valuePtrs...); err != nil {
log.Fatal(err)
}
//Created a map to handle the issue
var m map[string]interface{}
m = make(map[string]interface{})
for i := range columns {
m[columns[i]] = values[i]
}
v.Data = append(v.Data, m)
}
jsonMsg, err := json.Marshal(v)
return jsonMsg
}
Let me know if there exists a better solution.
This code is directly from my "sandbox" for MsSQL (using denisenkom/go-mssqldb and jmoiron/sqlx) - I think it helps showing different approaches and probably QueryIntoMap is what you were looking for:
package main
import (
"log"
"fmt"
_ "github.com/denisenkom/go-mssqldb"
"time"
"github.com/jmoiron/sqlx"
"encoding/json"
)
type Customer struct {
CustomerId string `db:"customerID" json:"customer_id"`
Company interface{} `db:"companyName" json:"company_name"`
Contact interface{} `db:"contactName" json:"contact_name"`
}
func main() {
connection := "server=192.168.55.3\\SqlExpress2012;database=Northwind;user id=me;Password=secret"
//QueryIntoMap(connection)
ScanIntoSlice(connection)
}
func QueryIntoMap(connection string) {
fmt.Println("QueryIntoMap sample")
fmt.Println("--------------------")
sel := `select customerId, companyName, contactName
from customers
where customerId = :id`
values := make(map[string]interface{})
db, err := sqlx.Open("mssql", connection)
//db.MapperFunc(strings.ToUpper)
e(err)
defer db.Close()
tx := db.MustBegin()
stmt, err := tx.PrepareNamed(sel)
e(err)
stmt.QueryRowx(map[string]interface{}{"id": "BONAP"}).MapScan(values)
tx.Commit()
for k, v := range values {
fmt.Printf("%s %v\n", k, v)
}
js, err := json.Marshal(values)
if err != nil {
fmt.Println(err)
}
fmt.Println(string(js))
fmt.Println("--------------------")
}
func ScanIntoStruct(connection string) {
fmt.Println("Scan into struct sample")
fmt.Println("--------------------")
db, err := sqlx.Open("mssql", connection)
e(err)
defer db.Close()
customer := Customer{}
rows, err := db.Queryx(`select customerID, companyName, contactName
from Customers`)
for rows.Next() {
err = rows.StructScan(&customer)
if err != nil {
log.Fatalln(err)
}
//fmt.Printf("%#v\n", user)
fmt.Printf("%-10s %-50v %-50v\n",
customer.CustomerId,
customer.Company,
customer.Contact)
js, err := json.Marshal(customer)
e(err)
fmt.Println(string(js))
}
fmt.Println("--------------------")
}
func ScanIntoSlice(connection string) {
fmt.Println("Scan into slice sample")
fmt.Println("--------------------")
start := time.Now()
db, err := sqlx.Open("mssql", connection)
e(err)
defer db.Close()
customers := []Customer{}
err = db.Select(&customers, `select customerID, companyName, contactName from customers`)
e(err)
for i, customer := range customers {
fmt.Printf("%3d. %-10s %-50v %-50v\n",
i,
customer.CustomerId,
customer.Company,
customer.Contact)
}
js, err := json.Marshal(customers)
e(err)
fmt.Println(string(js))
fmt.Printf("%s", time.Since(start))
fmt.Println("--------------------")
}
func e(err error) {
if err != nil {
log.Fatal(err)
}
}

Functions giving different result with same parameters

I use GMLib to work with Google maps and now I have come to a point where I am very confused.
I have the functions GetDistance and GetHeading to calculate the distance and compass direction between 2 markers on my map.
When I call them from my procedure GetHeadingDistance I get the result I expect (distance and direction is correct)- aSearchCallInfo is a class containing info that needs to be updated with the values.
Now I am trying to add a function that lets the user press the right mouse button on the map and the get info about that location.
But in this case I get very wrong results. As far as I can see of the results it uses GMMarker.Items[1].Position as source even when I know that it is GMMarker.Items[0].Position I send as parameter.
When I try to debug the functions by writing values to a textfile during calculation, I can see that it is the correct values it gets to work with at the correct position.
(GMMarker.Items[0].Position is the position of the user of the software)
Any ideas as what I could try to get this solved?
procedure TfrmQthMap.GMMapRightClick(Sender: TObject; LatLng: TLatLng; X, Y: Double);
var
MessageText: string;
LL: TLatLng;
Heading: double;
Distance: double;
Qra: string;
begin
if GMMarker.Count > 0 then
begin
LL := TLatLng.Create;
try
LL.Lat := LatLng.Lat;
LL.Lng := LatLng.Lng;
Heading := GetHeading(GMMarker.Items[0].Position, LL);
Distance := GetDistance(GMMarker.Items[0].Position, LL);
Qra := Maidenhead(LatLng.LngToStr, LatLng.LatToStr);
finally
FreeAndNil(LL);
end;
MessageText := 'Data for det sted du klikkede på: ' + sLineBreak + sLineBreak +
Format('Længdegrad: %s', [LatLng.LngToStr(Precision)]) + sLineBreak +
Format('Breddegrad: %s', [LatLng.LatToStr(Precision)]) + sLineBreak +
Format('Afstand: %6.1f km', [Distance]) + sLineBreak +
Format('Retning: %6.1f °', [Heading]) + sLineBreak +
Format('Lokator: %s', [Qra]);
ShowMessage(MessageText);
end;
end;
procedure TfrmQthMap.GetHeadingDistance(aSearchCallInfo: TCallInfo);
var
Heading: double;
Distance: double;
begin
if GMMarker.Count > 1 then
begin
Heading := GetHeading(GMMarker.Items[0].Position, GMMarker.Items[1].Position);
Distance := GetDistance(GMMarker.Items[0].Position, GMMarker.Items[1].Position);
barFooter.Panels[PanelDist].Text := Format('Afstand: %6.1f km', [Distance]);
barFooter.Panels[PanelDir].Text := Format('Retning: %6.1f°', [Heading]);
aSearchCallInfo.Distance := Format('%6.1f km', [Distance]);
aSearchCallInfo.Heading := Format('%6.1f °', [Heading]);
aSearchCallInfo.SaveToDatabase;
end;
end;
function TfrmQthMap.GetDistance(aOrigin, aDest: TLatLng): double;
var
Distance: double;
begin
Distance := TGeometry.ComputeDistanceBetween(GMMap, aOrigin, aDest);
Distance := Distance / 1000;
Result := Distance;
end;
function TfrmQthMap.GetHeading(aOrigin, aDest: TLatLng): double;
var
Heading: double;
begin
Heading := TGeometry.ComputeHeading(GMMap, aOrigin, aDest);
Heading := 180 + Heading;
Result := Heading;
end;

Replacing non-alphanumeric characters to html in crystal reports

I'm building a crystal report that ouputs XML-formatted text for a third party application.
The 3rd party app can't handle non-alphanumeric characters, so I have to convert them to HTML to be processed. At present, I use this code to catch the most common characters:
stringvar output := {table.fieldName};
output := Trim(output);
output := Replace (output,chrW(38),"&");
output := Replace (output,chrW(59),";");
output := Replace (output,"!","!");
output := Replace (output,chr(34),""");
output := Replace (output,chrW(35),"#");
output := Replace (output,"$","$");
output := Replace (output,"%","%");
output := Replace (output, chrW(39),"'");
output := Replace (output,"(","(");
output := Replace (output,")",")");
output := Replace (output,"*","*");
output := Replace (output,"+","+");
output := Replace (output,",",",");
output := Replace (output,"-","-");
output := Replace (output,".",".");
output := Replace (output,"/","/");
output := Replace (output,":",":");
output := Replace (output,"<","<");
output := Replace (output,"=","=");
output := Replace (output,">",">");
output := Replace (output,"?","?");
output := Replace (output,"#","#");
output := Replace (output,"[","[");
output := Replace (output,"\","\");
output := Replace (output,"]","]");
output := Replace (output,"^","^");
output := Replace (output,"_","_");
output := Replace (output,"`","`");
output := Replace (output,"{","{");
output := Replace (output,"|","|");
output := Replace (output,"}","}");
output := Replace (output,"~","~");
output := Replace (output, chrW(145),"‘");
output := Replace (output, chrW(146),"’");
output := Replace (output, chrW(147),"“");
output := Replace (output, chrW(148),"”");
output := Replace (output, chrW(8212),"—");
output := Replace (output, chrW(8217),"’");
output := Replace (output, chrW(8220),"“");
output := Replace (output, chrW(8221),"”");
output := Replace (output,"£","œ");
It's unweildly and needs maintenance. I'm adding characters to this as I find them, but I'm left wondering if there's a way, possibly using AscW and ChrW, to dynamically identify and convert non-alphanumeric character to it's html/ascii equivalent within the string.
I appear to have found this solution by adapting code designed to remove non-alphanumeric characters:
stringvar input := {table.fieldName};
stringvar output := '';
numbervar i;
input := Trim(input);
for i := 1 to Length(input) Step 1 do
// 0-9 is 48-57
// A-Z is 65-90
// a-z is 97-122
if not(input[i] in [chr(32), Chr(48),Chr(49),Chr(50),Chr(51),Chr(52),Chr(53),Chr(54),Chr(55),Chr(56),Chr(57),Chr(65),Chr(66),Chr(67),Chr(68),Chr(69),Chr(70),Chr(71),Chr(72),Chr(73),Chr(74),Chr(75),Chr(76),Chr(77),Chr(78),Chr(79),Chr(80),Chr(81),Chr(82),Chr(83),Chr(84),Chr(85),Chr(86),Chr(87),Chr(88),Chr(89),Chr(90),Chr(97),Chr(98),Chr(99),Chr(100),Chr(101),Chr(102),Chr(103),Chr(104),Chr(105),Chr(106),Chr(107),Chr(108),Chr(109),Chr(110),Chr(111),Chr(112),Chr(113),Chr(114),Chr(115),Chr(116),Chr(117),Chr(118),Chr(119),Chr(120),Chr(121),Chr(122)])
then
(output := output + "&#"+ cstr(ascw(input[i]),0)+";";)
else
if (input[i] in [chr(32), Chr(48),Chr(49),Chr(50),Chr(51),Chr(52),Chr(53),Chr(54),Chr(55),Chr(56),Chr(57),Chr(65),Chr(66),Chr(67),Chr(68),Chr(69),Chr(70),Chr(71),Chr(72),Chr(73),Chr(74),Chr(75),Chr(76),Chr(77),Chr(78),Chr(79),Chr(80),Chr(81),Chr(82),Chr(83),Chr(84),Chr(85),Chr(86),Chr(87),Chr(88),Chr(89),Chr(90),Chr(97),Chr(98),Chr(99),Chr(100),Chr(101),Chr(102),Chr(103),Chr(104),Chr(105),Chr(106),Chr(107),Chr(108),Chr(109),Chr(110),Chr(111),Chr(112),Chr(113),Chr(114),Chr(115),Chr(116),Chr(117),Chr(118),Chr(119),Chr(120),Chr(121),Chr(122)])
then
(output := output + input[i];) ;
output
Not perfect, but it works. Does anyone have a better solution?

Disappearing SubDetail TObjectList when JSonToObject

this is my first question. Sorry my english.
I have a classes like this:
TSFis_S = class(TPersistent)
private
_SFis_MID : Integer;
public
property SFis_MID : Integer read _SFis_MID write _SFis_MID;
end;
TSFis_D = class(TPersistent)
private
_SFis_MID : Integer;
_SFis_S : TObjectList<TSFis_S>;
public
property SFis_MID : Integer read _SFis_MID write _SFis_MID;
property SFis_S : TObjectList<TSFis_S> read _SFis_S write _SFis_S;
end;
TSFis_M = class(TPersistent)
private
_SFis_MID : Integer;
_SFis_D : TObjectList<TSFis_D>;
public
property SFis_MID : Integer read _SFis_MID write _SFis_MID;
property SFis_D : TObjectList<TSFis_D> read _SFis_D write _SFis_D;
function ToJSON:TJSONValue;
destructor Destroy;
end;
I trying convert TSFis_M Object to JSon and Revert to Object for my datasnap application. I use converts and reverters for my datatypes (TObjectList and TObjectList)
{ TSFis_M }
function JSonToSFis_M(json: TJSONValue): TSFis_M;
var
UnMarshaller: TJSONUnMarshal;
begin
if json is TJSONNull then
exit(nil);
UnMarshaller := TJSONUnMarshal.Create;
try
UnMarshaller.RegisterReverter(TSFis_M, '_FisTar',
procedure(Data: TObject; Field: string; Arg: string)
var
ctx: TRttiContext;
datetime :
TDateTime;
begin
datetime := EncodeDateTime(StrToInt(Copy(Arg, 7, 4)), StrToInt(Copy(Arg, 4, 2)), StrToInt(Copy(Arg, 1, 2)), StrToInt
(Copy(Arg, 12, 2)), StrToInt(Copy(Arg, 15, 2)), StrToInt(Copy(Arg, 18, 2)), 0);
ctx.GetType(Data.ClassType).GetField(Field).SetValue(Data, datetime);
end
);
UnMarshaller.RegisterReverter(TSFis_D, '_SFis_S',
procedure(Data: TObject; Field: String; Args: TListOfObjects)
var
obj: TObject;
SFisS: TObjectList<TSFis_S>;
SFis, SFisNew: TSFis_S;
begin
if TSFis_D(Data)._SFis_S=Nil
then TSFis_D(Data)._SFis_S := TObjectList<TSFis_S>.Create(True);
SFisS := TSFis_D(Data)._SFis_S;
SFisS.Clear;
for obj in Args do
begin
SFis := obj as TSFis_S;
SFisNew := TSFis_S.Create;
SFisS.Add(SFisNew);
SFisNew._SFis_MID := SFis._SFis_MID;
end;
end
);
UnMarshaller.RegisterReverter(TSFis_M, '_SFis_D',
procedure(Data: TObject; Field: String; Args: TListOfObjects)
var
obj: TObject;
SFisD: TObjectList<TSFis_D>;
SFis, SFisNew: TSFis_D;
i: integer;
begin
if TSFis_M(Data)._SFis_D=Nil then
TSFis_M(Data)._SFis_D := TObjectList<TSFis_D>.Create(True);
SFisD := TSFis_M(Data)._SFis_D;
SFisD.Clear;
for obj in Args do
begin
SFis := obj as TSFis_D;
SFisNew := TSFis_D.Create;
SFisD.Add(SFisNew);
SFisNew._SFis_MID := SFis._SFis_MID;
end;
end
);
exit(Unmarshaller.Unmarshal(json) as TSFis_M)
finally
UnMarshaller.Free;
end;
end;
function TSFis_M.ToJSON: TJSONValue;
var
Marshaller: TJSONMarshal;
begin
if Assigned(Self) then
begin
Marshaller := TJSONMarshal.Create(TJSONConverter.Create);
try
Marshaller.RegisterConverter(TSFis_M, '_SFis_D',
function(Data: TObject; Field: String): TListOfObjects
var
FisD: TObjectList<TSFis_D>;
i: integer;
begin
FisD := TSFis_M(Data)._SFis_D;
SetLength(Result, FisD.Count);
if FisD.Count > 0 then
for I := 0 to FisD.Count - 1 do
Result[I] := FisD[i];
end);
Marshaller.RegisterConverter(TSFis_M, '_FisTar',
function(Data: TObject; Field: string): string
var
ctx: TRttiContext; date : TDateTime;
begin
date := ctx.GetType(Data.ClassType).GetField(Field).GetValue(Data).AsType<TDateTime>;
Result := FormatDateTime('dd.mm.yyyy hh:nn:ss', date);
end);
Marshaller.RegisterConverter(TSFis_D, '_SFis_S',
function(Data: TObject; Field: String): TListOfObjects
var
FisD: TObjectList<TSFis_S>;
i: integer;
begin
FisD := TSFis_D(Data)._SFis_S;
SetLength(Result, FisD.Count);
if FisD.Count > 0 then
for I := 0 to FisD.Count - 1 do
Result[I] := FisD[i];
end);
exit(Marshaller.Marshal(Self))
finally
Marshaller.Free;
end;
end
else
exit(TJSONNull.Create);
end;
And finally
for example i put 1 Button and 2 Memo on the form. And i try My created Object convert to Json, Json.ToString to Memo1. And Convert that JSonValue to Object.
procedure TForm1.Button1Click(Sender: TObject);
var
MainFis : TSFis_M;
MainFis2 : TSFis_M;
DFis : TSFis_D;
SFis : TSFis_S;
begin
MainFis := TSFis_M.Create;
MainFis.SFis_D := TObjectList<TSFis_D>.Create(True);
DFis := TSFis_D.Create;
DFis._SFis_MID := 1;
MainFis.SFis_D.Add(DFis);
SFis := TSFis_S.Create;
SFis._SFis_MID := 1;
DFis.SFis_S := TObjectList<TSFis_S>.Create(True);
DFis.SFis_S.Add(SFis);
Memo1.Text := MainFis.ToJSON.ToString;
Edit1.Text := IntToStr(MainFis.SFis_D[0].SFis_S.Count);
MainFis2 := JSonToSFis_M(MainFis.ToJSON);
Edit2.Text := IntToStr(MainFis2.SFis_D[0].SFis_S.Count); // Access violation. Because MainFis2.SFis_D[0].SFis_S = Nil Now (That's the my problem. Why?)
Memo2.Text := MainFis2.ToJSon.ToString;
end;
But when i do this. TSFis_S is disappearing. In first step (ObjectToJSon) no problem.
{"type":"Unit1.TSFis_M","id":1,"fields":
{"_SFis_MID":0,"_SFis_D":
[ {"type":"Unit1‌​.TSFis_D","id":2,"fields":
{"_SFis_MID":1,"_SFis_S":
[ {"type":"Unit1.TSFis_S","id":‌​3,"fields":{"_SFis_MID":1} } ]
}
} ]
}
}
But when i trying revert to Object reverter goes wrong.
I can't found problem. What's my fault.
Thanks
PS: If i didn't explain, sample code here: http://goo.gl/3QnSw

Is there a Delphi standard function for escaping HTML?

I've got a report that's supposed to take a grid control and produce HTML output. One of the columns in the grid can display any of a number of values, or <Any>. When this gets output to HTML, of course, it ends up blank.
I could probably write up some routine to use StringReplace to turn that into <Any> so it would display this particular case correctly, but I figure there's probably one in the RTL somewhere that's already been tested and does it right. Anyone know where I could find it?
I am 99 % sure that such a function does not exist in the RTL (as of Delphi 2009). Of course - however - it is trivial to write such a function.
Update
HTTPUtil.HTMLEscape is what you are looking for:
function HTMLEscape(const Str: string): string;
I don't dare to publish the code here (copyright violation, probably), but the routine is very simple. It encodes "<", ">", "&", and """ to <, >, &, and ". It also replaces characters #92, #160..#255 to decimal codes, e.g. \.
This latter step is unnecessary if the file is UTF-8, and also illogical, because higher special characters, such as ∮ are left as they are, while lower special characters, such as ×, are encoded.
Update 2
In response to the answer by Stijn Sanders, I made a simple performance test.
program Project1;
{$APPTYPE CONSOLE}
uses
Windows, SysUtils;
var
t1, t2, t3, t4: Int64;
i: Integer;
str: string;
const
N = 100000;
function HTMLEncode(const Data: string): string;
var
i: Integer;
begin
result := '';
for i := 1 to length(Data) do
case Data[i] of
'<': result := result + '<';
'>': result := result + '>';
'&': result := result + '&';
'"': result := result + '"';
else
result := result + Data[i];
end;
end;
function HTMLEncode2(Data: string):string;
begin
Result:=
StringReplace(
StringReplace(
StringReplace(
StringReplace(
Data,
'&','&',[rfReplaceAll]),
'<','<',[rfReplaceAll]),
'>','>',[rfReplaceAll]),
'"','"',[rfReplaceAll]);
end;
begin
QueryPerformanceCounter(t1);
for i := 0 to N - 1 do
str := HTMLEncode('Testing. Is 3*4<3+4? Do you like "A & B"');
QueryPerformanceCounter(t2);
QueryPerformanceCounter(t3);
for i := 0 to N - 1 do
str := HTMLEncode2('Testing. Is 3*4<3+4? Do you like "A & B"');
QueryPerformanceCounter(t4);
Writeln(IntToStr(t2-t1));
Writeln(IntToStr(t4-t3));
Readln;
end.
The output is
532031
801969
It seems here is a small contest :) Here is a one more implementation:
function HTMLEncode3(const Data: string): string;
var
iPos, i: Integer;
procedure Encode(const AStr: String);
begin
Move(AStr[1], result[iPos], Length(AStr) * SizeOf(Char));
Inc(iPos, Length(AStr));
end;
begin
SetLength(result, Length(Data) * 6);
iPos := 1;
for i := 1 to length(Data) do
case Data[i] of
'<': Encode('<');
'>': Encode('>');
'&': Encode('&');
'"': Encode('"');
else
result[iPos] := Data[i];
Inc(iPos);
end;
SetLength(result, iPos - 1);
end;
Update 1: Updated initially provided incorrect code.
Update 2: And the times:
HTMLEncode : 2286508597
HTMLEncode2: 3577001647
HTMLEncode3: 361039770
I usually just use this code:
function HTMLEncode(Data:string):string;
begin
Result:=
StringReplace(
StringReplace(
StringReplace(
StringReplace(
StringReplace(
Data,
'&','&',[rfReplaceAll]),
'<','<',[rfReplaceAll]),
'>','>',[rfReplaceAll]),
'"','"',[rfReplaceAll]),
#13#10,'<br />'#13#10,[rfReplaceAll]);
end;
(copyright? it's open source)
Unit HTTPApp has a function called HTMLEncode. It has also other HTML/HTTP related functions.
I dont know in which delphi version it was introduced but, there is the System.NetEncoding unit which has:
TNetEncoding.HTML.Encode
TNetEncoding.HTML.Decode
functions. Read up here. You dont need external libraries anymore for that.
From unit Soap.HTTPUtil or simply HTTPUtil for older delphi versions, you can use
function HTMLEscape(const Str: string): string;
var
i: Integer;
begin
Result := '';
for i := Low(Str) to High(Str) do
begin
case Str[i] of
'<' : Result := Result + '<'; { Do not localize }
'>' : Result := Result + '>'; { Do not localize }
'&' : Result := Result + '&'; { Do not localize }
'"' : Result := Result + '"'; { Do not localize }
{$IFNDEF UNICODE}
#92, Char(160) .. #255 : Result := Result + '&#' + IntToStr(Ord(Str[ i ])) +';'; { Do not localize }
{$ELSE}
// NOTE: Not very efficient
#$0080..#$FFFF : Result := Result + '&#' + IntToStr(Ord(Str[ i ])) +';'; { Do not localize }
{$ENDIF}
else
Result := Result + Str[i];
end;
end;
end;
how about that way of replacing special characters:
function HtmlWeg(sS: String): String;
var
ix,cc: Integer;
sC, sR: String;
begin
result := sS;
ix := pos('\u00',sS);
while ix >0 do
begin
sc := copy(sS,ix+4,2) ;
cc := StrtoIntdef('$' +sC,32);
sR := '' + chr(cc);
sS := Stringreplace(sS, '\u00'+sC,sR,[rfreplaceall]) ;
ix := pos('\u00',sS);
end;
result := sS;
end;
My function combines the for-loop with a minimal reallocation of the string:
function HtmlEncode(const Value: string): string;
var
i: Integer;
begin
Result := Value;
i := 1;
while i <= Length(Result) do
begin
if Result[i] = '<' then
begin
Result[i] := '&';
Insert('lt;', Result, i + 1);
Inc(i, 4);
end
else if Result[i] = '>' then
begin
Result[i] := '&';
Insert('gt;', Result, i + 1);
Inc(i, 4);
end
else if Result[i] = '"' then
begin
Result[i] := '&';
Insert('quot;', Result, i + 1);
Inc(i, 6);
end
else if Result[i] = '&' then
begin
Insert('amp;', Result, i + 1);
Inc(i, 5);
end
else
Inc(i);
end;
end;
in delphi You have the function
THTMLEncoding.HTML.Encode