Dateizugriff mit WindowsAPI und Unicodeunterstützung

[Bomberbb]

Hallo,

Ich arbeite mit Delphi 5 und brauchte Unicodeunterstützung für die Dateibearbeitung. Da ich nichts gefunden habe, was mich ansprach, hab ich selbst was programmiert. Und da mir hier auch schon oft so nett geholfen wurde, wollte ich den Quelltext einfach mal online stellen. Für alle, die das gleiche Problem haben wie ich.

LG

BBB

Delphi-Quellcode:

{Dateien mit Hilfe der Windowsfunktionen einlesen und schreiben. Mit Unicodeunterstützung für
Dateinamen und -Inhalte. Systemvoraussetzung min. Win2000}
Unit UCFile;

Interface
Uses
  Windows;

Type
  TFileW = Class(TObject)
  Private
    fFileHandle:THandle;
    fFilename:WideString;
    fCharSize:Byte; //1 bei Ansi, 2 bei Unicode
    Procedure RaiseError(inError:Integer);
  Public
    EOF:Boolean;
    Constructor Create;
    Destructor Destroy; Override;
    Function OpenRead(Const inFileName:Widestring):Boolean;
    Function OpenWrite(Const inFileName:Widestring; inUnicode:Boolean):Boolean;
    Function OpenAppend(Const inFileName:Widestring; inUnicode:Boolean):Boolean;
    Procedure CloseFile;
    Function WriteLn(Const inString:WideString):Boolean;
    Function ReadLn(Var outString:WideString):Boolean;
    Function IsUnicode:Boolean;
  End;

Implementation

Const
  ANSICHARSIZE                          = 1;
  WIDECHARSIZE                          = 2;

Constructor TFileW.Create;
Begin { Create }
  Inherited;

  //Initiaalisierungen
  fFileHandle := INVALID_HANDLE_VALUE;
  fFilename := '';
  fCharSize := ANSICHARSIZE;
  EOF := False;
End; { Create }

Destructor TFileW.Destroy;
Begin { Destroy }
  If fFileHandle <> INVALID_HANDLE_VALUE Then
    closeHandle(fFileHandle);

  Inherited;
End; { Destroy }

Procedure TFileW.CloseFile;
Begin { CloseFile }
  If fFileHandle <> INVALID_HANDLE_VALUE Then
    closeHandle(fFileHandle);

  fFileHandle := INVALID_HANDLE_VALUE;
  fFileName := '';
End; { CloseFile }

Function TFileW.OpenRead(Const inFileName:Widestring):Boolean;
Var
  Bom                                   :String[1];
  BomRead                               :DWord;
Begin { OpenRead }
  Result := false;
  EOF := False;
  fFileName := inFileName;

  //Datei zum Lesen öffnen
  fFileHandle := CreateFileW(PWideChar(inFileName),GENERIC_READ,FILE_SHARE_READ,Nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  If fFileHandle <> INVALID_HANDLE_VALUE Then
  Begin
    fCharSize := ANSICHARSIZE;

    ReadFile(fFileHandle,BOM[0],WIDECHARSIZE,BomRead,Nil);

    //ByteOrderMark bei Unicode lesen
    If (BomRead = WIDECHARSIZE) And (BOM[0] = char($FF)) And (BOM[1] = Char($FE)) Then
      fCharSize := WIDECHARSIZE
    Else
    Begin
      SetFilePointer(fFileHandle,0,Nil,FILE_BEGIN);
      EOF := BomRead = 0
    End;

    Result := true;
  End
  Else
  Begin
    RaiseError(GetlastError);
    fFileName := '';
  End;
End; { OpenRead }

Function TFileW.OpenWrite(Const inFileName:Widestring; inUnicode:Boolean):Boolean;
Var
  C                                     :WideChar;
  BW                                    :DWord;
Begin { OpenWrite }
  Result := false;
  fFileName := inFileName;

  //Datei zum Schreiben öffnen
  fFileHandle := CreateFileW(PWideChar(inFileName),GENERIC_WRITE,FILE_SHARE_READ,Nil,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0);
  If fFileHandle <> INVALID_HANDLE_VALUE Then
  Begin
    If inUnicode Then
    Begin
      fCharSize := WIDECHARSIZE;

      //ByteOrderMark bei Unicode schreiben
      C := WideChar($FEFF);
      WriteFile(fFileHandle,C,fCharSize,BW,Nil);
    End
    Else
      fCharSize := ANSICHARSIZE;

    Result := true;
  End
  Else
  Begin
    RaiseError(GetlastError);
    fFileName := '';
  End;
End; { OpenWrite }

Function TFileW.OpenAppend(Const inFileName:Widestring; inUnicode:Boolean):Boolean;
Var
  Bom                                   :String[1];
  BomRead                               :DWord;
Begin { OpenAppend }
  Result := false;
  fFileName := inFileName;

  //Datei zum Lesen öffnen, damit Bestimmt werden kann, ob es sich um eine UnicodeDatei handelt
  fFileHandle := CreateFileW(PWideChar(inFileName),GENERIC_READ,FILE_SHARE_READ,Nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  If fFileHandle <> INVALID_HANDLE_VALUE Then
  Begin
    fCharSize := ANSICHARSIZE;

    ReadFile(fFileHandle,BOM[0],WIDECHARSIZE,BomRead,Nil);

    //Wenn das ByteOrderMark vorhanden ist, handelt es sich um eine Unicodedatei
    If (BomRead = WIDECHARSIZE) And (BOM[0] = char($FF)) And (BOM[1] = Char($FE)) Then
      fCharSize := WIDECHARSIZE

      closeHandle(fFileHandle);
    fFileHandle := INVALID_HANDLE_VALUE;

    //Datei zum Schreiben öffnen und Dateizeiger aufs Ende setzen
    fFileHandle := CreateFileW(PWideChar(inFileName),GENERIC_WRITE,FILE_SHARE_READ,Nil,CREATE_NEW,FILE_ATTRIBUTE_NORMAL,0);
    If fFileHandle <> INVALID_HANDLE_VALUE Then
    Begin
      SetFilePointer(fFileHandle,0,Nil,FILE_END);
      Result := true;
    End;
  End
  Else
  Begin
    RaiseError(GetlastError);
    fFileName := '';
  End;
End; { OpenAppend }

Function TFileW.WriteLn(Const inString:WideString):Boolean;
Var
  C                                     :WideChar;
  StrA                                  :String;
  BW                                    :DWord;
Begin { WriteLn }
  Result := false;
  If fFileHandle <> INVALID_HANDLE_VALUE Then
  Begin
    If length(inString) > 0 Then
    Begin
      If fCharSize = WIDECHARSIZE Then
      Begin
        //inString als unicode schreiben
        WriteFile(fFileHandle,inString[1],Length(inString) * fCharSize,BW,Nil);
      End
      Else
      Begin
        //inString in einen AnsiString umwwandeln
        StrA := inString;
        //Ansistring schreiben
        WriteFile(fFileHandle,StrA[1],Length(inString) * fCharSize,BW,Nil);
      End;

      If BW = 0 Then //Wenn weniger geschrieben wird als angefordert, dann gab es einen Fehler!
        RaiseError(GetlastError);

      Result := Length(inString) * fCharSize = abs(BW);
    End;

    //Wagenrücklauf schreiben
    C := WideChar(#13);
    WriteFile(fFileHandle,C,fCharSize,BW,Nil);

    //Zeilenvorschub schreiben
    C := WideChar(#10);
    WriteFile(fFileHandle,C,fCharSize,BW,Nil);
  End
  Else
    RaiseError(6);
End; { WriteLn }

Function TFileW.ReadLn(Var outString:WideString):Boolean;
Var
  C                                     :WideChar;
  CRLF                                  :Boolean;
  BR                                    :DWord;
  ErrorLoc                              :Integer;
Begin { ReadLn }
  Result := false;
  If fFileHandle <> INVALID_HANDLE_VALUE Then //Datei geöffnet
  Begin
    Result := true;
    CRLF := False;
    outString := '';
    While (Not EOF) And (Not CRLF) Do
    Begin
      fillchar(C,WIDECHARSIZE,0);
      ReadFile(fFileHandle,C,fCharSize,BR,Nil);

      If BR < fCharSize Then
      Begin {Wenn weniger ausgelesen wird als angefordert, dann gab es einen Fehler (z.B. Datei zum schreiben geöffnet oder der Dateizeiger befindet sich am Ende (EOF)}
        ErrorLoc := GetLastError;
        If ErrorLoc > 0 Then
          RaiseError(ErrorLoc);
        EOF := true;
      End;

      If Not EOF Then
      Begin //Auf Zeilenende überprüfen
        If (C = #13) Then
        Begin
          ReadFile(fFileHandle,C,fCharSize,BR,Nil);
          If (C = #10) Then
            CRLF := True;
        End
        Else
          outString := outString + C;
      End;
    End;
  End
  Else
    RaiseError(6);
End; { ReadLn }

Function TFileW.IsUnicode:Boolean;
Begin { IsUnicode }
  Result := fCharSize = WIDECHARSIZE;
End; { IsUnicode }

Procedure TFileW.RaiseError(inError:Integer);
Var
  dwSize                                :DWORD;
  lpszTemp                              :PAnsiChar;
  strw                                  :WideString;
Begin { RaiseError }
  dwSize := 512;
  lpszTemp := Nil;
  If inError <> 0 Then
  Begin
    Try
      // übergebenen Fehlercode in Fehlermeldung umwandeln.
      GetMem(lpszTemp,dwSize);
      FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_ARGUMENT_ARRAY,
        Nil,
        inError,
        LANG_NEUTRAL,
        lpszTemp,
        dwSize,
        Nil)
    Finally
      strw := lpszTemp; //strw wird benötigt, um MessageboxW aufzurufen.
      MessageBoxW(0,pWidechar(strw),pWidechar(fFilename),MB_ICONWARNING Or MB_OK);
      FreeMem(lpszTemp);
    End
  End;
End; { RaiseError }

End.