Welcome to BitCell. Click here to register !
Codul de mai jos scrie string-uri Unicode intr-un fisier text, folosind TFileStream. Daca fisierul nu exista, il creaza. Daca fisierul exista, dar nu are format Unicode, il va recrea (cu aceleasi date) in format Unicode.
Functia se comporta ca un WriteLn, dar daca parametrul aAddNewLine este pus pe False, se va comporta ca si Write.
- function StreamLog(aFilePath: String; aString: String;
- aAddNewLine: Boolean = True): Boolean;
- var
- lFile: TFileStream;
- lFileList: TStringList;
- lEnc: Word;
- begin
- Result := True;
- try
- try
- ForceDirectories(ExtractFilePath(aFilePath));
- except
- end;
- if FileExists(aFilePath)
- then lFile := TFileStream.Create(aFilePath, fmOpenReadWrite + fmShareCompat)
- else lFile := TFileStream.Create(aFilePath, fmCreate + fmShareCompat);
- if aAddNewLine then
- aString := aString + #13#10;
- if (lFile.Size = 0)
- then aString := Chr($FEFF) + aString
- else
- begin
- lFile.Read(lEnc, 2); // check file's encoding
- if (lEnc <> $FEFF) then // if it's not Unicode
- begin
- lFile.Free; // close the file, just in case
- lFileList := TStringList.Create; // open it with StringList
- lFileList.LoadFromFile(aFilePath); // load the file's content (assume it's text)
- lFileList.SaveToFile(aFilePath, TEncoding.Unicode); // save it as unicode
- lFile := TFileStream.Create(aFilePath,
- fmOpenReadWrite + fmShareCompat);
- // continue adding the text
- end;
- lFile.Seek(0, soFromEnd);
- end;
- lFile.Write(aString[1], Length(aString) * SizeOf(Char));
- lFile.Free;
- except
- Result := False;
- end;
- end;
Bafta
