以前自己收集了一份,(转载):
窗体文件:
object FormMain: TFormMain
Left = 292
Top = 170
Width = 659
Height = 480
Caption = '汉字'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 456
Top = 128
Width = 161
Height = 41
Caption = '打开'
TabOrder = 0
OnClick = Button1Click
end
object ListBox1: TListBox
Left = 0
Top = 0
Width = 409
Height = 453
Align = alLeft
ItemHeight = 13
TabOrder = 1
end
object Button2: TButton
Left = 456
Top = 80
Width = 161
Height = 41
Caption = '清空列表'
TabOrder = 2
OnClick = Button2Click
end
object Button3: TButton
Left = 456
Top = 176
Width = 161
Height = 41
Caption = '转化'
TabOrder = 3
OnClick = Button3Click
end
object OpenDialog1: TOpenDialog
Filter = '*.dfm|*.dfm'
Options = [ofHideReadOnly, ofAllowMultiSelect, ofEnableSizing]
Left = 536
Top = 16
end
end
单元文件:
unit UnitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TFormMain = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
ListBox1: TListBox;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormMain : TFormMain;
implementation
{$R *.dfm}
procedure ConvertFile(iFileName, oFileName: string);
function Space(Count: Integer): string;
begin
if Count <= 0 then
result := ''
else
begin
SetLength(Result, Count);
FillMemory(Pchar(Result), Count, $20);
end;
end;
var
IMS : TMemoryStream;
SourceFile : TStrings;
Parser : TParser;
TStr, OldTstr : string;
OStr : string;
SPos : Integer;
sLine : Integer;
SpaceLen : Integer;
begin
IMs := TMemoryStream.Create;
SourceFile := TStringList.Create;
try
SourceFile.LoadFromFile(iFileName);
IMS.LoadFromFile(iFileName);
IMS.Position := 0;
Parser := TParser.Create(IMS);
sLine := Parser.SourceLine;
SPos := Parser.SourcePos;
while not (Parser.Token = toEOF) do
begin
tStr := Parser.TokenString;
if sLine <> Parser.SourceLine then
begin
OStr := OStr + #13 + #10;
sLine := Parser.SourceLine;
end;
case Parser.Token of
toString:
begin
tStr := '''' + tStr + '''';
end;
toWString:
begin
tStr := '''' + Parser.TokenWideString + '''';
end;
end;
SpaceLen := Parser.SourcePos - SPos - Length(Oldtstr);
if SpaceLen < 0 then
SpaceLen := 0;
OStr := OStr + Space(SpaceLen) + tStr;
case Parser.Token of
toString:
begin
Oldtstr := '''' + Parser.TokenString + '''';
end;
else
begin
Oldtstr := Parser.TokenString;
end;
end;
SPos := Parser.SourcePos;
Parser.NextToken;
end;
SourceFile.Text := OStr;
if (not FileExists(oFileName)) or
(Application.MessageBox(PChar('是否覆盖文件' + oFileName), '', MB_YESNO) =
ID_YES) then
SourceFile.SaveToFile(oFileName);
finally
SourceFile.Free;
IMS.Free;
end;
end;
procedure TFormMain.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
ListBox1.Items.Assign(OpenDialog1.Files);
end;
procedure TFormMain.Button2Click(Sender: TObject);
begin
ListBox1.Clear;
end;
procedure TFormMain.Button3Click(Sender: TObject);
var
I : Integer;
IFileName, OFileName: string;
begin
for I := 0 to ListBox1.Items.Count - 1 do
begin
IFileName := ListBox1.Items;
OFileName := IFileName + '.TXT';
ConvertFile(IFileName, OFileName);
end;
ShowMessage('转换完毕');
end;
end.