Neuer Typ "TFileStreamUTF8"

MmVisual · Beitrag von **MmVisual** » Do 14. Jul 2011, 21:23

Hallo,
ich wollte ein "TFileStreamUTF8" erzeugen, dazu habe ich folgenden Code aus den Lazarus Sourcen kopiert und entsprechend abgeändert:

Code: Alles auswählen

Interface
 
Type
  TFileStreamUTF8 = class(THandleStream)
  Private
    FFileName : String;
  public
    constructor Create(const AFileName: string; Mode: Word);
    constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal);
    destructor Destroy; override;
    property FileName : String Read FFilename;
  end;
 
const // Baucht es sonst nicht kompilierbar:
  AccessMode: array[0..2] of Cardinal  = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareModes: array[0..4] of Integer = (
               0,
               0,
               FILE_SHARE_READ,
               FILE_SHARE_WRITE,
               FILE_SHARE_READ or FILE_SHARE_WRITE);   
 
 ResourceString
  SFCreateError                 = 'Unable to create file "%s"';
  SFOpenError                   = 'Unable to open file "%s"';
 
implementation
Function FileOpenUTF8 (Const FileName : string; Mode : Integer) : THandle;
begin
  result := CreateFileW(PWideChar(UTF8Decode(FileName)), dword(AccessMode[Mode and 3]),
                       dword(ShareModes[(Mode and $F0) shr 4]), nil, OPEN_EXISTING,
                       FILE_ATTRIBUTE_NORMAL, 0);
end;
 
Function FileCreateUTF8 (Const FileName : String; ShareMode : Integer; Rights : Integer) : THandle;
begin
  FileCreateUTF8 := CreateFileW(PWideChar(UTF8Decode(FileName)), GENERIC_READ or GENERIC_WRITE,
                       dword(ShareModes[(ShareMode and $F0) shr 4]), nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
end;
 
{****************************************************************************}
{*                             TFileStreamUTF8                              *}
{****************************************************************************}
 
constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word);
begin
  FFileName:=AFileName;
  If (Mode and fmCreate) > 0 then
    FHandle:=FileCreateUTF8(AFileName,Mode,438)
  else
    FHAndle:=FileOpenUTF8(AFileName,Mode);
 
  If (THandle(FHandle)=feInvalidHandle) then
    If Mode=fmcreate then
      raise EFCreateError.createfmt(SFCreateError,[AFileName])
    else
      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
end;
 
 
constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
begin
  FFileName:=AFileName;
  If (Mode and fmCreate) > 0 then
    FHandle:=FileCreateUTF8(AFileName,Mode,Rights)
  else
    FHAndle:=FileOpenUTF8(AFileName,Mode);
 
  If (THandle(FHandle)=feInvalidHandle) then
    If Mode=fmcreate then
      raise EFCreateError.createfmt(SFCreateError,[AFileName])
    else
      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
end;
 
 
destructor TFileStreamUTF8.Destroy;
begin
  FileClose(FHandle);
end;

Eigentlich ist das ganze so kopiert wie aus "TFileStream" aber in meiner Quelle erkennt der nicht die Variable "FHandle", die existiert nicht. In der abgeleiteten Klasse "THandleStream" ist die aber vorhanden und das ganze klappt schließlich auch mit "TFileStream".

Kann mir bitte jemand einen Tipp geben warum mein Code sich nicht kompilieren lässt

Vielen Dank im Voraus, Gruß Markus.

gocher · Beitrag von **gocher** » Do 14. Jul 2011, 22:39

Versuchs mal einfach ohne "F" nur Handle denn als property wird Handle vom Typ THandle als nur lesbar von FHandle angeboten!
Also zuweisen kannst du nichts aber zumindest schon mal lesen!

gocher · Beitrag von **gocher** » Do 14. Jul 2011, 22:46

Ups Du schreibst ja auch in die Variable FHandle, dann kannst du die Typ-Definition in classesh.inc und die Funktionen in streams.inc einfügen dort ist auch FHandle bekannt!

MmVisual · Beitrag von **MmVisual** » Do 14. Jul 2011, 23:19

Das kann ich nicht so einfach, da ich keine Ahnung habe wie ich die RTL neu kompilieren kann.
Weißt Du wie das geht?

Ich habe das schon mal für die RTL vorbereitet und sogar hier gepostet:
http://bugs.freepascal.org/view.php?id=19742" onclick="window.open(this.href);return false;

Gruß Markus

gocher · Beitrag von **gocher** » Fr 15. Jul 2011, 08:00

RTL ist ein Bestandteil von Free Pascal, ich denke dafür musst du Free Pascal neu kompilieren und wahrscheinlich auch Lazarus.

Ungefähr so:

Code: Alles auswählen

set fpcPath=c:\fpc
set lazPath=c:\freepascal
set FPCBINDIR=c:\FPCBINDIR
...
set PATH=%FPCBINDIR%;%fpcBuildInstallPath%\binw32;%fpcVersionPath%;%fpcBuildBinariesPath%;%PATH%
cd %fpcPath%
make clean all install OS_TARGET=win32 CPU_TARGET=i386 INSTALL_PREFIX=%fpcVersionPath% 
cd %lazPath%
make clean all PP=fpc.exe

Du solltest natürlich die Pfade richtig setzen wie sie bei Dir auf dem Rechner existieren!

MmVisual · Beitrag von **MmVisual** » Fr 15. Jul 2011, 08:37

Hmm. Das ganze wird wohl bei mir nicht so einfach klappen.

Ich habe das Setup "Lazarus-0.9.31-31683-fpc-2.5.1-20110713-win32.exe" nach D:\ installiert.
Dann habe ich das Verzeichnis "D:\lazarus\fpc\2.5.1\bin\i386-win32" wo fpc.exe und ppc386.exe drin sind.

Das make braucht für den Ablauf das "makefile" und das hab ich nicht.

Ich vermute mal ich müsste aus dem SVN was laden. Gibt es irgend wo eine Anleitung wie ich das machen kann, für FPC V2.5.1?

Vielen Dank im Voraus.
Grüße Markus

Website · Beitrag von **Socke** » Fr 15. Jul 2011, 11:20

Ich empfehle die neue Klasse nicht in die eigene RTL zu integrieren, da sie bei einem Update ganz leicht überschieben wird, außer man macht sich die Arbeit das ganze nachzupflegen. Besser wäre es ein eigenes Verzeichnis mit eigenen Units zu erstellen.

Zum Problem:
Das Handle übergibt man THandleStream im Constructor und nirgends anders. Es wird dann im privaten Feld FHandle gespeichert, auf das man über die public Eigenschaft Handle lesend zugreifen kann. Das ist vollkommen ausreichen, da sich ein Handle (aus User-Programm-Sicht) nie verändert und daher auch nie geändert werden muss.

@MnVisual: schau dir doch mal die Implementierung von TFileStream an; da musst du nur die API-Wrapper-Aufrufe austauschen. Ich habs dennoch mal kurz deinen Quelltext korrigiert, gebe aber keine Garantier auf Copy&Run; du solltest auch überprüfen, ob du den richtigen THandle-Typ verwendest -- es gibt nämlich zwei Stück: einmal System.THandle für Betriebssystemhandles und eine anderes in der LCL für Steuerelemente. Am besten schreibst du ziemlich weit oben in deiner Unit "THandle = System.THandle" um das richtige zu verwenden.

Code: Alles auswählen

constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word);
begin
  // In Pascal kann man auch andere Constructoren aufrufen
  Create(AFileName, Mode, 438); 
end;
 
constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
var
  tmpHandle: THandle;
begin
  FFileName:=AFileName;
  If (Mode and fmCreate) > 0 then
    tmpHandle:=FileCreateUTF8(AFileName,Mode,Rights)
  else
    thandleHandle:=FileOpenUTF8(AFileName,Mode);
   If (THandle(FHandle)=feInvalidHandle) then
    If Mode=fmcreate then
      raise EFCreateError.createfmt(SFCreateError,[AFileName])
    else
      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
  // das Handle an den Constructor von THandleStream übergeben
  inherited Create(tempHandle);
end;
 
destructor TFileStreamUTF8.Destroy;
begin
  // und wieder schließen, das Handle wird dabei (aus Sicht deines Programms) nicht verändert
  FileClose(Handle);
end;

MmVisual · Beitrag von **MmVisual** » Fr 15. Jul 2011, 16:46

Perfekt, Passt, Vielen Dank!!!

Wenn jemand z.B. ein TPicture laden möchte dann muss er eben den TFileStreamUTF8 verwenden und mit LoadFromStream kann man das dann machen.

Leider unterstützt die RTL kein UTF8 unter Windows, die Entwickler sagen, man solle das doch in die LCL implementieren. Ich finde, das ist irgendwie doof.

Hier der Code:

Code: Alles auswählen

Interface
Type
  TFileStreamUTF8 = class(THandleStream)
  Private
    FFileName : String;
  public
    constructor Create(const AFileName: string; Mode: Word);
    constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal);
    destructor Destroy; override;
    property FileName : String Read FFilename;
  end;
 
  TStringListUTF8 = class(TStringList)
  public
    constructor Create;
    destructor Destroy; override;
    procedure SaveToFileUTF8(const FileName: string);
    procedure LoadFromFileUTF8(const FileName: string);
  end;
 
const
  AccessMode: array[0..2] of Cardinal  = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareModes: array[0..4] of Integer = (
               0,
               0,
               FILE_SHARE_READ,
               FILE_SHARE_WRITE,
               FILE_SHARE_READ or FILE_SHARE_WRITE);  
 
function CopyFileUTF8(const SrcFilename, DestFilename: String; PreserveTime: Boolean = False): Boolean;
 
 
ResourceString
  SFCreateError                 = 'Unable to create file "%s"';
  SFOpenError                   = 'Unable to open file "%s"';
 
implementation
 
Function FileOpenUTF8 (Const FileName : string; Mode : Integer) : THandle;
begin
  result := CreateFileW(PWideChar(UTF8Decode(FileName)), dword(AccessMode[Mode and 3]),
                       dword(ShareModes[(Mode and $F0) shr 4]), nil, OPEN_EXISTING,
                       FILE_ATTRIBUTE_NORMAL, 0);
  //if fail api return feInvalidHandle (INVALIDE_HANDLE=feInvalidHandle=-1)
end;
 
Function FileCreateUTF8 (Const FileName : String) : THandle;
begin
  Result := FileCreateUTF8(FileName, fmShareExclusive, 0);
end;
 
Function FileCreateUTF8 (Const FileName : String; Rights:longint) : THandle;
begin
  FileCreateUTF8 := FileCreateUTF8(FileName, fmShareExclusive, Rights);
end;
 
Function FileCreateUTF8 (Const FileName : String; ShareMode : Integer; Rights : Integer) : THandle;
begin
  FileCreateUTF8 := CreateFileW(PWideChar(UTF8Decode(FileName)), GENERIC_READ or GENERIC_WRITE,
                       dword(ShareModes[(ShareMode and $F0) shr 4]), nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
end;
 
{****************************************************************************}
{*                             TFileStreamUTF8                              *}
{****************************************************************************}
constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word);
Var hFile: THandle;
begin
  FFileName:=AFileName;
  If (Mode and fmCreate) = fmCreate then
  Begin
    If FileExistsUTF8(AFileName) Then
      DeleteFileUTF8(AFileName);
    hFile:=FileCreateUTF8(AFileName,Mode,438)
  end
  else
    hFile:=FileOpenUTF8(AFileName,Mode);
 
  If hFile=THandle(-1) then
    If (Mode and fmCreate) = fmCreate then
      raise EFCreateError.createfmt(SFCreateError,[AFileName])
    else
      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
  inherited Create(hFile);
end;
 
constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
Var hFile: THandle;
begin
  FFileName:=AFileName;
  If (Mode and fmCreate) = fmCreate then
  Begin
    If FileExistsUTF8(AFileName) Then
      DeleteFileUTF8(AFileName);
    hFile:=FileCreateUTF8(AFileName,Mode,Rights)
  end
  else
    hFile:=FileOpenUTF8(AFileName,Mode);
 
  If hFile=THandle(-1) then
    If (Mode and fmCreate) = fmCreate then
      raise EFCreateError.createfmt(SFCreateError,[AFileName])
    else
      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
  inherited Create(hFile);
end;
 
 
destructor TFileStreamUTF8.Destroy;
begin
  FileClose(Handle);
  inherited Destroy;
end;
 
 
{****************************************************************************}
{*                             TFileStreamUTF8                              *}
{****************************************************************************}
constructor TStringListUTF8.Create;
Var hFile: THandle;
begin
  inherited Create;
end;
 
destructor TStringListUTF8.Destroy;
begin
  inherited Destroy;
end;
 
procedure TStringListUTF8.SaveToFileUTF8(const FileName: string);
Var TheStream : TFileStreamUTF8;
Begin
  TheStream:=TFileStreamUTF8.Create(FileName,fmCreate);
  try
    SaveToStream(TheStream);
  finally
    TheStream.Free;
  end;
end;
 
procedure TStringListUTF8.LoadFromFileUTF8(const FileName: string);
Var TheStream : TFileStreamUTF8;
begin
  TheStream:=TFileStreamUTF8.Create(FileName,fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(TheStream);
  finally
    TheStream.Free;
  end;
end;          
 
function CopyFileUTF8(const SrcFilename, DestFilename: String; PreserveTime: Boolean = False): Boolean;
var
  SrcFS: TFileStreamUTF8;
  DestFS: TFileStreamUTF8;
begin
  try
    SrcFS := TFileStreamUTF8.Create(SrcFilename, fmOpenRead or fmShareDenyWrite);
    try
      DestFS := TFileStreamUTF8.Create(DestFilename, fmCreate);
      try
        DestFS.CopyFrom(SrcFS, SrcFS.Size);
      finally
        DestFS.Free;
      end;
      if PreserveTime then
        FileSetDateUTF8(DestFilename, FileGetDate(SrcFS.Handle));
    finally
      SrcFS.Free;
    end;
    Result := True;
  except
    Result := False;
  end;
end;

Grüße Markus.

Teekeks · Beitrag von **Teekeks** » Fr 15. Jul 2011, 17:35

Hi!
Noch eine kleine Verbesserung (aussehen ^^)

Code: Alles auswählen

constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word);
Var hFile: THandle;
begin
  FFileName:=AFileName;
  If (Mode and fmCreate) = fmCreate then
  Begin
    If FileExistsUTF8(AFileName) Then
      DeleteFileUTF8(AFileName);
    hFile:=FileCreateUTF8(AFileName,Mode,438)
  end
  else
    hFile:=FileOpenUTF8(AFileName,Mode);
 
  If hFile=THandle(-1) then
    If (Mode and fmCreate) = fmCreate then
      raise EFCreateError.createfmt(SFCreateError,[AFileName])
    else
      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
  inherited Create(hFile);
end;
 
constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
Var hFile: THandle;
begin
  FFileName:=AFileName;
  If (Mode and fmCreate) = fmCreate then
  Begin
    If FileExistsUTF8(AFileName) Then
      DeleteFileUTF8(AFileName);
    hFile:=FileCreateUTF8(AFileName,Mode,Rights)
  end
  else
    hFile:=FileOpenUTF8(AFileName,Mode);
 
  If hFile=THandle(-1) then
    If (Mode and fmCreate) = fmCreate then
      raise EFCreateError.createfmt(SFCreateError,[AFileName])
    else
      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
  inherited Create(hFile);
end;

wird zu

Code: Alles auswählen

constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word);
begin
   Create(AFileName,Mode,438);
end;
 
constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
Var hFile: THandle;
begin
  FFileName:=AFileName;
  If (Mode and fmCreate) = fmCreate then
  Begin
    If FileExistsUTF8(AFileName) Then
      DeleteFileUTF8(AFileName);
    hFile:=FileCreateUTF8(AFileName,Mode,Rights)
  end
  else
    hFile:=FileOpenUTF8(AFileName,Mode);
 
  If hFile=THandle(-1) then
    If (Mode and fmCreate) = fmCreate then
      raise EFCreateError.createfmt(SFCreateError,[AFileName])
    else
      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
  inherited Create(hFile);
end;

Dann musst du immer nur eine Routine warten wenn sich was ändert.

Eclipticon · Beitrag von **Eclipticon** » Fr 15. Jul 2011, 17:42

Und noch schoener mit einem default parameter, oder?

MmVisual · Beitrag von **MmVisual** » Fr 15. Jul 2011, 22:29

Ja, stimmt, jetzt sieht es so aus und es gibt nur noch einen Constructor:

Code: Alles auswählen

constructor TFileStreamUTF8.Create(const AFileName: string; Mode: Word; Rights: Cardinal = 438);

Der Original RTL Code für TFileStream sieht irgendwie buggy aus (Datei streams.inc).
z.B. steht das in der einen Zeile:
If (Mode and fmCreate) > 0 then

und das ein paar Zeilen tiefer:
If Mode=fmcreate then

In der Deklaration Steht bei fmCreate = $FFFF, also wenn nur ein Bit gesetzt ist, dann geht es nicht mehr.
Wieso die RTL dennoch funktioniert ist mir ein Rätsel.

gocher · Beitrag von **gocher** » Sa 16. Jul 2011, 17:12

MmVisual hat geschrieben:if (Mode and fmCreate) > 0 then

Wenn in Mode ein Bit gesetzt ist dann geht es

Deutsches Lazarusforum

Neuer Typ "TFileStreamUTF8"

Neuer Typ "TFileStreamUTF8"

Re: Neuer Typ "TFileStreamUTF8"

Re: Neuer Typ "TFileStreamUTF8"

Re: Neuer Typ "TFileStreamUTF8"

Re: Neuer Typ "TFileStreamUTF8"

Re: Neuer Typ "TFileStreamUTF8"

Re: Neuer Typ "TFileStreamUTF8"

Re: Neuer Typ "TFileStreamUTF8"

Re: Neuer Typ "TFileStreamUTF8"

Re: Neuer Typ "TFileStreamUTF8"

Re: Neuer Typ "TFileStreamUTF8"

Re: Neuer Typ "TFileStreamUTF8"