Обработка unicode текстового файла
Добавлено: 11.05.2016 14:16:38Доброго времени суток.
Когда-то программерил на паскале и вот потребовалось "вспомнить молодость".
Надо написать програмку на Pascal для обработки текстовых файлов под Windows в кодировке Unicode.
Копался в Интернете, справке и тд и ничего найти путного не смог, как-то писал, пытался и ничего толкового не получилось.
Под обычный Дос наклепал заготовку програмки за пол часа, все, что она должна делать, это выдергивать цитаты из текстового файла и писать их другой файл.
Помогите пожалуйста переделать ее под Unicode:
Когда-то программерил на паскале и вот потребовалось "вспомнить молодость".
Надо написать програмку на Pascal для обработки текстовых файлов под Windows в кодировке Unicode.
Копался в Интернете, справке и тд и ничего найти путного не смог, как-то писал, пытался и ничего толкового не получилось.
Под обычный Дос наклепал заготовку програмки за пол часа, все, что она должна делать, это выдергивать цитаты из текстового файла и писать их другой файл.
Помогите пожалуйста переделать ее под Unicode:
- Код: Выделить всё
const
Ent = #13#10 ;
var
FileIn,
FileOut : Text ;
S1, S2 : String ;
L : Longint ;
W1, W2 : Word ;
B1, B2 : Byte ;
procedure Quit (ErrCode: byte) ;
var
Stmp : String ;
begin
case ErrCode of
00 : Stmp:='Done !'+Ent ;
01 : Stmp:='Usage: Str_Export <InFile> <OutFile>'+Ent ;
02 : Stmp:='Error in Input File.'+Ent ;
03 : Stmp:='Error in Output File.'+Ent ;
else
Stmp:='Unknown Error.'+Ent ;
end ;
Write(Stmp) ;
{$I-}
Close(FileIn) ;
IOResult ;
Close(FileOut) ;
IOResult ;
{$I+}
Halt(ErrCode) ;
end ;
procedure Init ;
begin
if ParamCount <> 2 then Quit(1) ;
Assign(FileIn, ParamStr(1)) ;
Assign(FileOut, ParamStr(2)) ;
{$I-}
Reset(FileIn) ;
if IOResult <> 0 then Quit(2) ;
Reset(FileOut) ;
if IOResult = 0 then Quit(3) ;
Rewrite(FileOut) ;
if IOResult <> 0 then Quit(3) ;
{$I+}
end ;
begin
Init ;
while not EoF(FileIn) do
begin
ReadLn(FileIn, S1) ;
S2:='' ;
b1:=1 ;
repeat
if S1[b1] = '"' then
begin
b2:=b1+1 ;
while (S1[b2] <> '"') and (b2 <= byte(S1[0])) do
begin
S2:=S2+S1[b2] ;
inc(b2) ;
end ;
b1:=b2 ;
end ;
inc(b1) ;
until b1 > byte(S1[0]) ;
if S2 <> '' then WriteLn(FileOut, S2) ;
end ;
Quit(0) ;
end.