[gold-concert]

Доброго времени!
Пишу программу простенькую и возник вопросик.
Как сделать чтобы файл сохранялся в кодировке UTF а не ANSI?
Вот мой код:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, jpeg, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    Edit2: TEdit;
    Memo1: TMemo;
    Label3: TLabel;
    Label4: TLabel;
    Memo2: TMemo;
    Label5: TLabel;
    Memo3: TMemo;
    Label6: TLabel;
    Memo4: TMemo;
    Button2: TButton;
    Button3: TButton;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
  FOutFile: string;
  procedure WriteXML;
  function CheckOutFileExists(const p_FName:string):Boolean;
  procedure SetOutFile(const Value:string);
  procedure AddScript;
  procedure NewTovar;
    { Private declarations }
  public
  property OutFile: string read FOutFile write SetOutFile;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.show;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
OutFile := ExtractFilePath(Application.ExeName) + Edit1.Text + '.html';
AddScript;
end;

procedure TForm1.AddScript;
var
I: Integer;
begin
  Memo1.Lines.BeginUpdate;
  for I := 0 to Memo1.Lines.Count - 1 do
    begin
      Memo1.Lines[i] := Memo1.Lines[i] + '</br>';
    end;
    Memo1.Lines.EndUpdate;
    Memo2.Lines.BeginUpdate;
  for I := 0 to Memo2.Lines.Count - 1 do
    begin
      Memo2.Lines[i] := Memo2.Lines[i] + '</br>';
    end;
    Memo2.Lines.EndUpdate;
    Memo3.Lines.BeginUpdate;
  for I := 0 to Memo3.Lines.Count - 1 do
    begin
      Memo3.Lines[i] := Memo3.Lines[i] + '</br>';
    end;
    Memo3.Lines.EndUpdate;
    Memo4.Lines.BeginUpdate;
  for I := 0 to Memo4.Lines.Count - 1 do
    begin
      Memo4.Lines[i] := Memo4.Lines[i] + '</br>';
    end;
    Memo4.Lines.EndUpdate;
    WriteXML;
end;

procedure TForm1.WriteXML;
var
f: TextFile;
begin
 AssignFile(f, OutFile);
 try
   Rewrite(f);
   writeln(f, '<p>' + Edit2.Text + '</p>');
   writeln(f, Memo1.Text + '</p>');
   writeln(f, Memo2.Text + '</p>');
   writeln(f, Memo3.Text + '</p>');
   writeln(f, Memo4.Text + '</p>');
   writeln(f, '</body>');
   writeln(f, '</html>');

 finally
    CloseFile(f);
    NewTovar;
    ShowMessage ('Страница создана успешно!');
 end;
end;

procedure TForm1.NewTovar;
begin
  Edit1.Text := '';
  Edit2.Text := '';
  Memo1.Text := '';
  Memo2.Text := '';
  Memo3.Text := '';
  Memo4.Text := '';
end;

function TForm1.CheckOutFileExists(const p_FName:string): Boolean;
begin
  result := True;
end;

procedure TForm1.SetOutFile(const Value: String);
begin
  if CheckOutFileExists(Value) then
  FOutFile := Value;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Form1.close;
end;

end.

Вот. Собственно собирал из примеров исходников и все получилось как мне надо, все работает. Но вот из-за кодировки полученный html не отображается нормально, пока в ручную не поменяешь.

Я видел пример от Karsh:

Код:

//записываем
procedure TForm1.Button2Click(Sender: TObject);
var
  w: hwnd;
  x, l: dword;
  s: PWideChar;
begin
  l:= Length(Edit1.Text)*2 + Length('[aa]' + #13#10 + 'gg=')*2 + 1; // вычисляем длину юникодовой строки (в строке каждый символ занимает 2 байта + 1 байт управляющий)
  GetMem(s, l);
  StringToWideChar('[aa]' + #13#10 + 'gg=' + Edit1.Text, s, 256);
  w:= CreateFileW('c:\ss.ini', GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);
  WriteFile(w, s[0], lstrlenW(s)*2, x, nil);
  CloseHandle(w);
  FreeMem(s, l);
end;

Но что-то пойму как его к моей программке прикрутить.. Помогите плз..

[ChinYan]

Нужно, чтобы файл был отмечен, как UTF например так:

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  S: TStream;
  Sign: Cardinal;
begin
  S := TFileStream.Create('C:\1.txt',fmCreate);
  try
    Sign := $BFBBEF;
    S.WriteBuffer(Sign, 3);
    S.WriteBuffer(PChar('Hello World!')^, 12);
  finally
    S.Free;
  end;
end;

[gold-concert]

А где тут отмечается как UTF?
Я просто больше по html, чем по Делфи, но немного понимаю.

[ChinYan]

Вот здесь:

Код:

Sign := $BFBBEF;        (*Это признак UTF*)
    S.WriteBuffer(Sign, 3); (*И мы его пишем в файл*)

[gold-concert]

Понял, а мне это дело надо принемить до WriteXML?
Я прошу прощения, просто я Delphi знаю очень поверхностно, а сделать по зарез нужно.....

Если я сделаю так:

Код:

procedure convert;
var
  S: TStream;
  Sign: Cardinal;
begin
  S := TFileStream.Open(Edit1.Text + '.html',fmCreate);
  try
    Sign := $BFBBEF;
    S.WriteBuffer(Sign, 3);
  finally
    S.Free;
  end;
end;

И просто перед вызовом Newtovar; вызову также convert;
Есессно в private объявлю
procedure convert;

Или это я плохо придумал?

Сам спросил - сам отвечу. Попробовал - не работает.
Может кто знает как это все дело применить к моему случаю?

[ChinYan]

Здесь файл не конвертируется в UTF, здесь он только отмечается, как UTF.

Код:

procedure TForm1.WriteXML;
var
f: TextFile;
S: TStream;
  Sign: Cardinal;
begin

S := TFileStream.Create(Edit1.Text + '.html',fmCreate);
  try
    Sign := $BFBBEF;
    S.WriteBuffer(Sign, 3);
  finally
    S.Free;
end;

 AssignFile(f, OutFile);
 try
   Append(f);
   writeln(f, '<p>' + Edit2.Text + '</p>');
   writeln(f, Memo1.Text + '</p>');
   writeln(f, Memo2.Text + '</p>');
   writeln(f, Memo3.Text + '</p>');
   writeln(f, Memo4.Text + '</p>');
   writeln(f, '</body>');
   writeln(f, '</html>');

 finally
    CloseFile(f);
    NewTovar;
    ShowMessage ('Страница создана успешно!');
 end;
end;