Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Dateizugriff mit WindowsAPI und Unicodeunterstützung (https://www.delphipraxis.net/149802-dateizugriff-mit-windowsapi-und-unicodeunterstuetzung.html)

Bomberbb 30. Mär 2010 15:57


Dateizugriff mit WindowsAPI und Unicodeunterstützung
 
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.

Bernhard Geyer 30. Mär 2010 16:24

Re: Dateizugriff mit WindowsAPI und Unicodeunterstützung
 
Zitat:

Zitat von Bomberbb
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.

Die TNTWare-Controls würden das als OpenSource auch das ElPack als Kaufkomponenten würden sowas bieten. Und sogar noch in einer Version das das Programm unter Win9x/ME lauffähig ist.

Luckie 30. Mär 2010 19:47

Re: Dateizugriff mit WindowsAPI und Unicodeunterstützung
 
Delphi-Quellcode:
If (BomRead = WIDECHARSIZE) And (BOM[0] = char($FF)) And (BOM[1] = Char($FE)) Then
      fCharSize := WIDECHARSIZE
Nicht jeder Unicode-Datei hat den BOM.

Bomberbb 30. Mär 2010 20:06

Re: Dateizugriff mit WindowsAPI und Unicodeunterstützung
 
@Bernhard: Unter TNT-Ware hab ich keine Writln-Methode gefunden.
@Lucky: Mir ist keine andere Methode eingefallen zu checken, ob es sich um Unicode handelt.

Luckie 30. Mär 2010 20:17

Re: Dateizugriff mit WindowsAPI und Unicodeunterstützung
 
Die gibt es auch nicht:
http://blogs.msdn.com/oldnewthing/ar.../24/95235.aspx
http://blogs.msdn.com/oldnewthing/ar...7/2158334.aspx


Alle Zeitangaben in WEZ +1. Es ist jetzt 09:26 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz