unit dfileiterator_nosysutils;

interface

uses
{$IF Defined(WINDOWS)}
  windows,
{$ELSEIF Defined(UNIX)}
  BaseUnix,
{$ENDIF}
  derror;

type
TFileIterator = object
private
  FDir: AnsiString;
  FFileName: AnsiString;
{$IF Defined(WINDOWS)}
  FFindFileData: windows.WIN32_FIND_DATAW;
  FHandle: windows.HANDLE;
{$ELSEIF Defined(UNIX)}
  FOpenedDir: BaseUnix.PDir;
{$ENDIF}
public
  procedure Init(const Dir: AnsiString; Error: PError = nil);
  procedure Done(Error: PError = nil);
  function Next(Error: PError = nil): Boolean;
  property FileName: AnsiString read FFileName;
end;

implementation

uses
  strings;

{$IFDEF WINDOWS}
// TODO dwindows
procedure WindowsFormatError(Code: Cardinal;
                             CodeContext: PAnsiChar;
                             Buffer: PAnsiChar;
                             Size: Cardinal);
var
  L: LongInt;
begin
  // Copy code infotmation
  L := Length(CodeContext);
  if L > Size then
    L := Size;
  Move(CodeContext^, Buffer^, L + 1);
  Dec(Size, L);
  Inc(Buffer, L);

  FormatMessageA(
      FORMAT_MESSAGE_FROM_SYSTEM or
      FORMAT_MESSAGE_IGNORE_INSERTS,
      nil,
      Code,
      MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_US),
      Buffer,
      Size,
      nil);

  // FormatMessage adds new lines to the result, we want to remove it
  L := Length(Buffer) - 1;
  while (L >= 0) and
        ((Buffer[L] = AnsiChar(13)) or (Buffer[L] = AnsiChar(10))) do
    Dec(L);
  Buffer[L + 1] := #0;
end;

procedure WindowsGetLastError(CodeContext: PAnsiChar;
                              Error: PError); inline;
var
  Buffer: array[0 .. 128 - 1] of AnsiChar;
begin
  if Error <> nil then begin
    Error^.Id := windows.GetLastError;
    WindowsFormatError(Error^.Id,
                       CodeContext,
                       @Buffer[0],
                       Length(Buffer));
    Error^.Msg := PAnsiChar(@Buffer[0]);
  end;
end;

function WindowsUtf8ToWide(Utf8: PAnsiChar;
                           Buffer: PWideChar;
                           Len: Cardinal;
                           Error: PError): Boolean;
begin
  Result := 0 <> windows.MultiByteToWideChar(CP_UTF8,
                                             MB_ERR_INVALID_CHARS,
                                             Utf8,
                                             StrLen(Utf8) + 1,
                                             Buffer,
                                             Len);
  if not Result then
    WindowsGetLastError('(MultiByteToWideChar) ', Error);
end;

function StrLenW(Wide: PWideChar): LongInt;
begin
  Result := 0;
  while Wide[Result] <> WideChar(#0) do
    Inc(Result);
end;

function WindowsWideToUtf8(Wide: PWideChar;
                           Buffer: PAnsiChar;
                           Len: Cardinal;
                           Error: PError): Boolean;
begin
  Result := 0 <> windows.WideCharToMultiByte(CP_UTF8,
                                             0,
                                             Wide,
                                             StrLenW(Wide) + 1,
                                             Buffer,
                                             Len,
                                             nil,
                                             nil);
  if not Result then
    WindowsGetLastError('(MultiByteToWideChar) ', Error);
end;
{$ENDIF}

procedure TFileIterator.Init(const Dir: AnsiString; Error: PError = nil);
{$IFDEF WINDOWS}
var
  Buffer: array[0..260] of WideChar;
{$ENDIF}
begin
  Initialize(Self);
  FDir := Dir;
  FFileName := '';
{$IF Defined(WINDOWS)}
  FHandle := 0;
  if not WindowsUtf8ToWide(@FDir[1], @Buffer[0], Length(Buffer), {Error}nil) then
    Exit;
  FHandle := FindFirstFileW(@Buffer[0], @FFindFileData);
  if FHandle = INVALID_HANDLE_VALUE then begin
    FHandle := 0;
    WindowsGetLastError('(TFileIterator.FindFirstFileW) ', {Error}nil);
    Exit;
  end;
{$ELSEIF Defined(UNIX)}
  if (Length(FDir) >= 2) and (FDir[Length(FDir)] = '*') and (FDir[Length(FDir) - 1] = '/') then
    SetLength(FDir, Length(FDir) - 2);
  FOpenedDir := FpOpenDir(FDir);
{$ENDIF}
end;

procedure TFileIterator.Done;
begin
{$IF Defined(WINDOWS)}
  if FHandle <> 0 then begin
    FindClose(FHandle);
  end;
{$ELSEIF Defined(UNIX)}
  if FOpenedDir = nil then
    Exit;
  FpCloseDir(FOpenedDir^);
{$ENDIF}
  Finalize(Self);
end;

function TFileIterator.Next(Error: PError = nil): Boolean;
var
  Buffer: array[0..260] of AnsiChar;
{$IF Defined(UNIX)}
  ADirent: BaseUnix.PDirent;
{$ENDIF}
begin
{$IF Defined(WINDOWS)}
  while FHandle <> 0 do begin
    Result := WindowsWideToUtf8(@FFindFileData.cFileName[0], @Buffer[0], Length(Buffer), Error);
    if not FindNextFileW(FHandle, @FFindFileData) then begin
      WindowsGetLastError('(FindNextFileW) ', Error);
      if (Error <> nil) and (Error^.Id = ERROR_NO_MORE_FILES) then begin
        Error^.Id := OK; // is not a error
        Error^.Msg := '';
      end;
      FindClose(FHandle);
      FHandle := 0;
    end;
    if Result then begin
      FFileName := PAnsiChar(@Buffer[0]);
      if (FFileName <> '.') and (FFileName <> '..') then
        Exit(True);
    end;
  end;
  Exit(False);
{$ELSEIF Defined(UNIX)}
  if FOpenedDir = nil then
    Exit(False);
  ADirent := FpReadDir(FOpenedDir^);
  if ADirent <> nil then begin
    FFileName := PAnsiChar(@ADirent^.d_name[0]);
    Writeln(FFileName);
    Exit(True);
  end;
  Exit(False);
{$ELSE}
  Exit(False);
{$ENDIF}
end;

end.
