кодировка xml

[veniside]

> UTF8 и не пахнет.

согласись, мы не знаем, что и как записывается в Product перед вызовом NewXMLFail2(). Может, там такой код:

var
  Product: RawByteString;
begin
  Product := UTF8Encode(Product_Name);
  NewXMLFail2();
end;

хотя надежд на это мало.

[Жолдас]

давайте я вам скину весь програмнны кож что бы было понятно а то я уже неделью не сделать



unit uConv;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, ExtCtrls, ComCtrls, StdCtrls, Buttons, DB, ADODB;

const ar: array [1..21] of string = ('AKSAY', 'AKTAU', 'AKTOBE', 'ALMATY', 'ALMATY2', 'ASTANA', 'ATYRAU', 'KARAGANDA', 'KOKSHETAU', 'KOSTANAI', 'MAIN OFFICE', 'NONAME', 'OSKEMEN', 'PAVLODAR', 'PETROPAVLOVSK', 'SEMEY', 'SHIMKENT', 'TALDYKORGAN', 'TARAZ', 'URALSK', 'VIP');
arCode: array [1..21] of string = ('413310', '413304', '413305', '413302', '413317', '413303', '413301', '413306', '413314', '413312', '4133', '304133', '413309', '413311', '413318', '413319', '413307', '413308', '413315', '413316', '413313');
arSer: array [1..21] of string = ('07', '03', '04', '01', '15', '05', '10', '02', '17', '12', 'MAIN OFFICE', 'NONAME', '08', '11', '16', '19', '06', '18', '13', '14', '15');
type
TForm2 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
Panel1: TPanel;
sgNClient: TStringGrid;
sgOClient: TStringGrid;
Panel2: TPanel;
sgClient: TStringGrid;
Panel3: TPanel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
BitBtn8: TBitBtn;
BitBtn9: TBitBtn;
Label1: TLabel;
lNClient: TLabel;
lOClient: TLabel;
Label4: TLabel;
lClient: TLabel;
Label6: TLabel;
ADOQuery1: TADOQuery;
ADOQuery1CCON: TStringField;
ADOQuery1NAME: TStringField;
ADOQuery1CCARD: TStringField;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn8Click(Sender: TObject);
procedure NewXMLFail;
procedure NewXMLFail2;
procedure BitBtn1Click(Sender: TObject);
function GrabLine2(const s: string): string;
function RegNumberNext(const s: string): string;
function ApplNumberNext(const s: string): string;
procedure BitBtn4Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;


var
Form2: TForm2; Number:integer;
ServiceGroup, ClientNumber, RegNumber, RegDate, RegNumberDetails,
FirstName, LastName, MiddleName, CompanyName, BirthDate,
TRFirstName, TRLastName, AddressLine1, ContractNumber, Dprt,
SecurityName,WorkP, HomeP, MobileP, HomeFax, State, Product, ProductCard,
CompanyTradeName, City, BirthPlace, r2 :string;


implementation

uses uExcelWork, uMain;

{$R *.dfm}

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form1.Close;
end;

procedure TForm2.FormShow(Sender: TObject);
const FRow: array [0..25] of string = ('ServiceGroup','FirstName','LastNa me','FathersName','BirthDate','Clie ntNumber',
'RegNumber','RegNumberDetails','Fax _H','Birth_Place','City','Сlient_vi d',
'AddressLine1','CompanyName', 'TRFirstName',
'TRLastName','WorkPhone','HomePhone ','MobilePhone','Product',
'Product(Card)','SecurityName','Cen treProfit','RegDate','Region','');
var i:integer;
begin
for i:=0 to 24 do
begin
sgNClient.Cells[i,0]:=FRow[i];
sgOClient.Cells[i,0]:=FRow[i];
sgClient.Cells[i,0]:=FRow[i];
end;
sgClient.Cells[i,0]:=FRow[i];
end;

procedure TForm2.BitBtn2Click(Sender: TObject);
begin
if SaveAsExcelFile(sgNClient, 'NClient', PrPath+'SaveExcel\NewClient_'+DateT oStr(Now)+'.xls') then
ShowMessage('Данные сохранены!');
end;

procedure TForm2.BitBtn5Click(Sender: TObject);
begin
if SaveAsExcelFile(sgOClient, 'OClient', PrPath+'SaveExcel\OldClient_'+DateT oStr(Now)+'.xls') then
ShowMessage('Данные сохранены!');
end;

procedure TForm2.BitBtn8Click(Sender: TObject);
begin
if SaveAsExcelFile(sgClient, 'Client', PrPath+'SaveExcel\BadClient_'+DateT oStr(Now)+'.xls') then
ShowMessage('Данные сохранены!');
end;

procedure TForm2.NewXMLFail;
var
f: Textfile; hm: string;

[Жолдас]

procedure TForm2.NewXMLFail;
var
f: Textfile; hm: string;
begin
hm:=timetostr(Time);
if hm[2]=':' then hm:='0'+hm;
AssignFile(f, PrPath+'Out\New\'+ApplNumberNext(Pr Path+'IN\ApplNumber.txt')); {Assigns the Filename}
ReWrite(f); {Create a new file named ek.txt}
Writeln(f, '<?xml version="1.0" encoding="windows-1251"?>');
Writeln(f, '<ApplicationFile>');
Writeln(f, ' <FileHeader>');
Writeln(f, ' <FormatVersion>2.0</FormatVersion>');
Writeln(f, ' <Sender>000100</Sender>');
Writeln(f, ' <CreationDate>'+FormatDateTime('yyy y-mm-dd', Date)+'</CreationDate>');
Writeln(f, ' <CreationTime>'+hm+'</CreationTime>');
Writeln(f, ' <Number>'+inttostr(Number)+'</Number>');
Writeln(f, ' <Institution>0001</Institution>');
Writeln(f, ' </FileHeader>');
Writeln(f, ' <ApplicationsList>');
Writeln(f, ' <Application>');
Writeln(f, ' <RegNumber>'+RegNumberNext(PrPath+' IN\RegNumber.txt')+'</RegNumber>');
Writeln(f, ' <OrderDprt>'+Dprt+'</OrderDprt>');
Writeln(f, ' <ObjectType>Client</ObjectType>');
Writeln(f, ' <ActionType>Add</ActionType>');
Writeln(f, ' <ProductGroup>ISSPRIV</ProductGroup>');
Writeln(f, ' <Data>');
Writeln(f, ' <Client>');
Writeln(f, ' <Institution>0001</Institution>');
Writeln(f, ' <OrderDprt>'+Dprt+'</OrderDprt>');
Writeln(f, ' <ClientType>APR_</ClientType>');
Writeln(f, ' <ServiceGroup>'+ServiceGroup+'</ServiceGroup>');
Writeln(f, ' <ClientInfo>');
Writeln(f, ' <ClientNumber>'+ClientNumber+'</ClientNumber>');
Writeln(f, ' <RegNumberType>7</RegNumberType>');
Writeln(f, ' <RegNumber>'+RegNumber+'</RegNumber>');
Writeln(f, ' <RegNumberDetails>'+RegNumberDetail s+'</RegNumberDetails>');
if MiddleName = '' then
Writeln(f, ' <ShortName>'+FirstName+' '+LastName[1]+'..</ShortName>')
else
Writeln(f, ' <ShortName>'+FirstName+' '+LastName[1]+'.'+MiddleName[1]+'.</ShortName>');
Writeln(f, ' <FirstName>'+LastName+'</FirstName>');
Writeln(f,' <LastName>'+FirstName+'</LastName>');
Writeln(f, ' <MiddleName>'+MiddleName+'</MiddleName>');
Writeln(f, ' <SecurityName>'+SecurityName+'</SecurityName>');
Writeln(f, ' <Country>110</Country>');
Writeln(f, ' <Language>R</Language>');
Writeln(f, ' <CompanyName>'+CompanyName+'</CompanyName>');
Writeln(f, ' <CompanyTradeName>'+CompanyTradeNam e+'</CompanyTradeName>');
Writeln(f, ' <BirthDate>'+BirthDate+'</BirthDate>');
Writeln(f, ' <BirthPlace>'+BirthPlace+'</BirthPlace>');
Writeln(f, ' <BirthName>N</BirthName>');
Writeln(f, ' </ClientInfo>');
Writeln(f, ' <PlasticInfo>');
Writeln(f, ' <FirstName>'+TRFirstName+'</FirstName>');
Writeln(f, ' <LastName>'+TRLastName+'</LastName>');
Writeln(f, ' </PlasticInfo>');
Writeln(f, ' <PhoneList>');
Writeln(f, ' <Phone>');
Writeln(f, ' <PhoneType>Fax</PhoneType>');
Writeln(f, ' <PhoneNumber>'+WorkP+'</PhoneNumber>');

[Жолдас]

Writeln(f, ' </Phone>');
Writeln(f, ' <Phone>');
Writeln(f, ' <PhoneType>Home</PhoneType>');
Writeln(f, ' <PhoneNumber>'+HomeP+'</PhoneNumber>');
Writeln(f, ' </Phone>');
Writeln(f, ' <Phone>');
Writeln(f, ' <PhoneType>Mobile</PhoneType>');
Writeln(f, ' <PhoneNumber>'+MobileP+'</PhoneNumber>');
Writeln(f, ' </Phone>');
Writeln(f, ' <Phone>');
Writeln(f, ' <PhoneType>HomeFax</PhoneType>');
Writeln(f, ' <PhoneNumber>'+HomeFax+'</PhoneNumber>');
Writeln(f, ' </Phone>');
Writeln(f, ' </PhoneList>');
Writeln(f, ' <BaseAddress>');
Writeln(f, ' <Country>110</Country>');
Writeln(f, ' <State>'+State+'</State>');
Writeln(f, ' <City>'+City+'</City>');
Writeln(f, ' <AddressLine1>'+AddressLine1+'</AddressLine1>');
Writeln(f, ' <AddressLine3>'+r2+'</AddressLine3>');
Writeln(f, ' </BaseAddress>');
Writeln(f, ' <AddInfo>');
Writeln(f, ' <ADDDATE01>'+RegDate+'</ADDDATE01>');
Writeln(f, ' </AddInfo>');
Writeln(f, ' </Client>');
Writeln(f, ' </Data>');
Writeln(f, ' <SubApplList>');
Writeln(f, ' <Application>');
Writeln(f, ' <RegNumber>'+RegNumberNext(PrPath+' IN\RegNumber.txt')+'</RegNumber>');
Writeln(f, ' <OrderDprt>'+Dprt+'</OrderDprt>');
Writeln(f, ' <ObjectType>Contract</ObjectType>');
Writeln(f, ' <ActionType>Add</ActionType>');
Writeln(f, ' <ProductGroup>ISSPRIV</ProductGroup>');
Writeln(f, ' <Data>');
Writeln(f, ' <Contract>');
Writeln(f, ' <Institution>0001</Institution>');
Writeln(f, ' <InstitutionIDType>Bank</InstitutionIDType>');
Writeln(f, ' <ClientType>APR_</ClientType>');
Writeln(f, ' <ServiceGroup>'+ServiceGroup+'</ServiceGroup>');
Writeln(f, ' <Product>');
Writeln(f, ' <ProductCode1>'+Product+'</ProductCode1>');
Writeln(f, ' </Product>');
Writeln(f, ' </Contract>');
Writeln(f, ' </Data>');
Writeln(f, ' <SubApplList>');
Writeln(f, ' <Application>');
Writeln(f, ' <RegNumber>'+RegNumberNext(PrPath+' IN\RegNumber.txt')+'</RegNumber>');
Writeln(f, ' <OrderDprt>'+Dprt+'</OrderDprt>');
Writeln(f, ' <ObjectType>Contract</ObjectType>');
Writeln(f, ' <ActionType>Add</ActionType>');
Writeln(f, ' <ProductGroup>ISSPRIV</ProductGroup>');
Writeln(f, ' <Data>');
Writeln(f, ' <Contract>');
Writeln(f, ' <Institution>0001</Institution>');
Writeln(f, ' <InstitutionIDType>Bank</InstitutionIDType>');
Writeln(f, ' <ClientType>APR_</ClientType>');
Writeln(f, ' <ServiceGroup>'+ServiceGroup+'</ServiceGroup>');
Writeln(f, ' <Product>');
Writeln(f, ' <ProductCode1>'+ProductCard+'</ProductCode1>');
Writeln(f, ' </Product>');
Writeln(f, ' <PlasticInfo>');
Writeln(f, ' <FirstName>'+TRFirstName+'</FirstName>');
Writeln(f, ' <LastName>'+TRLastName+'</LastName>');
Writeln(f, ' </PlasticInfo>');
Writeln(f, ' </Contract>');
Writeln(f, ' </Data>');
Writeln(f, ' </Application>');
Writeln(f, ' </SubApplList>');
Writeln(f, ' </Application>');
Writeln(f, ' </SubApplList>');
Writeln(f, ' </Application>');
Writeln(f, ' </ApplicationsList>');
Writeln(f, '</ApplicationFile>');
Closefile(f); {Closes file F}
end;

procedure TForm2.BitBtn1Click(Sender: TObject);
var i,j:integer;
begin
try
for i:=1 to sgNClient.RowCount-1 do
begin
ServiceGroup:= trim(sgNClient.Cells[0,i]);
ClientNumber:= trim(sgNClient.Cells[5,i]);
RegNumber:= trim(sgNClient.Cells[6,i]);
RegNumberDetails:= trim(sgNClient.Cells[7,i]);
FirstName:= trim(sgNClient.Cells[1,i]);
LastName:= trim(sgNClient.Cells[2,i]);
MiddleName:= trim(sgNClient.Cells[3,i]);
CompanyName:= trim(sgNClient.Cells[13,i]);
BirthDate:= FormatDateTime('yyyy-mm-dd', StrToDate(trim(sgNClient.Cells[4,i])));
RegDate:= FormatDateTime('yyyy-mm-dd', StrToDate(trim(sgNClient.Cells[23,i])));
TRFirstName:= trim(sgNClient.Cells[14,i]);
TRLastName:= trim(sgNClient.Cells[15,i]);
AddressLine1:= trim(sgNClient.Cells[12,i]);
SecurityName:= trim(sgNClient.Cells[21,i]);
WorkP:= trim(sgNClient.Cells[16,i]);
HomeP:= trim(sgNClient.Cells[17,i]);
MobileP:= trim(sgNClient.Cells[18,i]);
HomeFax:= trim(sgNClient.Cells[8,i]);
State:= trim(sgNClient.Cells[22,i]);
CompanyTradeName:= trim(sgNClient.Cells[11,i]);

[Жолдас]

City:= trim(sgNClient.Cells[10,i]);
BirthPlace:= trim(sgNClient.Cells[9,i]);
r2:= trim(sgNClient.Cells[24,i]);
ADOQuery1.Close;
ADOQuery1.Parameters.ParamByName('p n').Value:= trim(sgNClient.Cells[19,i]);
ADOQuery1.Open;
while not ADOQuery1.Eof do
begin
if ADOQuery1NAME.Value= trim(sgNClient.Cells[20,i]) then
begin
Product:= ADOQuery1CCON.AsString;
ProductCard:= ADOQuery1CCARD.AsString;
end;
ADOQuery1.Next;
end;
for j:=1 to 17 do
if ServiceGroup = ar[j] then
begin
Dprt:= arCode[j];
ServiceGroup:= arSer[j];
end;
NewXMLFail;
end;
ShowMessage(IntToStr(i-1)+' аппликации созданны!');
except
ShowMessage('Ошибка при создании аппликации, проверти строку '+IntToStr(i-2)+' или обратитись к разработчику!');
end
end;

function TForm2.GrabLine2(const s: string): string;
var
sl: TStringList;
begin
sl := TStringList.Create;
try
sl.LoadFromFile(s);
if sl.Count=0 then Result:=''
else Result := sl[sl.count-1]; // index off by one
finally
sl.Free;
end;
end;

function TForm2.RegNumberNext(const s: string): string;
var
f : Textfile;
s1, s2:string;
k,i,j,n:integer;
begin
s1:= GrabLine2(s);
if s1 = '' then s1:='A_XML_000000'
else
begin
s2:=s1;
delete(s2,1,6);
delete(s1,7,length(s1));
k:=StrToInt(s2);
inc(k);
j:=0;
n:=k;
while k>0 do
begin
k:=k div 10;
inc(j);
end;
for i:=1 to 6-j do
s1:=s1+'0';
s1:=s1+IntToStr(n);
end;
AssignFile(f, s);
try
if FileExists(s) = False then
Rewrite(f)
else
begin
Append(f);
end;
// Writeln(f, '');
Writeln(f, s1);
Result := s1;
finally
CloseFile(f);
end;
end;

[Жолдас]

помогите ребенку степи

[Utkin]

Смысл в том, что ты вносишь данные не в UTF8. Перед тем как добавлять свои строки, они должны быть сконвертированы в UTF8. Это общий косяк программы (пример поста №11 описывает как это можно исправить). Далее - никогда не пиши важные обработки данных и глобальные данные непосредственно в кликах мыши и оконных процедурах - замучаешься потом сопровождать. Вся логика программы должна работать изначально без оконного интерфейса. В кликах, отображениях формы манипуляции с данными должны быть минимальны, вызывай обертки. Ну это уже так бурчание со стороны...

[Жолдас]

Сообщение от Utkin

Смысл в том, что ты вносишь данные не в UTF8. Перед тем как добавлять свои строки, они должны быть сконвертированы в UTF8. Это общий косяк программы (пример поста №11 описывает как это можно исправить). Далее - никогда не пиши важные обработки данных и глобальные данные непосредственно в кликах мыши и оконных процедурах - замучаешься потом сопровождать. Вся логика программы должна работать изначально без оконного интерфейса. В кликах, отображениях формы манипуляции с данными должны быть минимальны, вызывай обертки. Ну это уже так бурчание со стороны...

а как наити этот пример поста №11

[ZuBy]

http://www.programmersforum.ru/showp...0&postcount=11

[veniside]

вот примерно так (для юникодной и неюникодной Дельфи):

var
  s: UTF8String;
  Product: wideString;
  xml: wideString;
  f: TextFile;
begin
  // BOM
  s := '   ';
  s[1] := #$EF;
  s[2] := #$BB;
  s[3] := #$BF; 

  // data
  Product := 'Фыва Одновалентная';

  // text
  xml := 
    '<?xml version="1.0" encoding="utf-8"?>' +
    '<Product>' +
    '<name>' + Product + '</name>' +
    '</Product>';

  // text -> UTF8
  s := s + UTF8Encode(xml);

  // file
  AssignFile(f, 'test.xml');
  ReWrite(f);
  WriteLn(f, s);
  CloseFile(f);
end.

Product:= ADOQuery1CCON.AsString;

AsString() по-моему возвращает AnsiString, тогда предполагаем, что из базы строки читаются в корректной кодировке (в той, которая по-умолчанию для неюникодных строк).