atxfproc.pas

ATViewer is a component for Delphi/C++Builder, which allows to view files of various types. There is

  FillChar(Buffer, SizeOf(Buffer), 0);
  SetFilePointer(h, 0, nil, FILE_BEGIN);
  Result :=
    ReadFile(h, Buffer, SizeOf(Buffer), BytesRead, nil) and
    (BytesRead >= SizeOf(Buffer)) and
    ((Buffer[0] = $EF) and (Buffer[1] = $BB) and (Buffer[2] = $BF));
end;

function IsFileRTF(h: THandle): Boolean;
const
  Sign = '{\rtf';
  SignLen = Length(Sign);
var
  Buffer: packed array[0..SignLen] of Char; //Sign + #0
  BytesRead: DWORD;
begin
  FillChar(Buffer, SizeOf(Buffer), 0);
  SetFilePointer(h, 0, nil, FILE_BEGIN);
  {$WARNINGS OFF}
  Result :=
    ReadFile(h, Buffer, SignLen, BytesRead, nil) and
    (BytesRead >= SignLen) and
    (Buffer = Sign);
  {$WARNINGS ON}
end;

procedure IsFileRTFAndUTF8(const AFileName: WideString; var IsRTF, IsUTF8: Boolean);
var
  h: THandle;
begin
  IsRTF := False;
  IsUTF8 := False;

  h := FFileOpen(AFileName);
  if h <> INVALID_HANDLE_VALUE then
    try
      IsRTF := IsFileRTF(h);
      IsUTF8 := IsFileUTF8(h);
    finally
      CloseHandle(h);
    end;
end;


type
  TFreqTable = array[$80 .. $FF] of Integer;

function IsFileText(h: THandle; BufSizeKb: DWORD; DetectOEM: Boolean; var IsOEM: Boolean): Boolean;
var
  Buffer: PChar;
  BufSize, BytesRead, i: DWORD;
  n: Integer;
  Table: TFreqTable;
  TableSize: Integer;
begin
  Result := False;
  IsOEM := False;

  if BufSizeKb = 0 then Exit;
  Buffer := nil;
  BufSize := BufSizeKb * 1024;

  //Init freq table
  TableSize := 0;
  FillChar(Table, SizeOf(Table), 0);

  try
    GetMem(Buffer, BufSize);
    FillChar(Buffer^, BufSize, 0);
    SetFilePointer(h, 0, nil, FILE_BEGIN);

    if ReadFile(h, Buffer^, BufSize, BytesRead, nil) then
      if BytesRead > 0 then
      begin
        Result := True;
        for i := 0 to BytesRead - 1 do
        begin
          n := Ord(Buffer[i]);

          //If control chars present, then non-text
          if (n < 32) and (n <> 09) and (n <> 13) and (n <> 10) then
            begin Result := False; Break end;

          //Calculate freq table
          if DetectOEM then
            if (n >= Low(Table)) and (n <= High(Table)) then
            begin
              Inc(TableSize);
              Inc(Table[n]);
            end;
        end;
      end;

    //Analize table
    if DetectOEM then
      if Result and (TableSize > 0) then
        for i := Low(Table) to High(Table) do
        begin
          Table[i] := Table[i] * 100 div TableSize;
          if ((i >= $B0) and (i <= $DF)) or (i = $FF) or (i = $A9) then
            if Table[i] >= 18 then
              begin IsOEM := True; Break end;
        end;

  finally
    if Assigned(Buffer) then
      FreeMem(Buffer);
  end;
end;


procedure SAddSlash(var S: AnsiString);
begin
  if (S <> '') and (S[Length(S)] <> '\') then
    S := S + '\';
end;

function FFileNameWideToAnsi(const FileName: WideString): AnsiString;
begin
  if IsDirExist(FileName) then
  begin
    Result := FileName;
    //Convert to short form only "pure Unicode" names:
    if FileName <> WideString(AnsiString(FileName)) then
    begin
      Result := FGetShortName(FileName);
      if not IsDirExist(Result) then
        Result := '';
    end;
    //Add trailing slash, Lister plugins expect it:
    SAddSlash(Result);
  end
  else
  begin
    Result := FileName;
    //Convert to short form only "pure Unicode" names:
    if FileName <> WideString(AnsiString(FileName)) then
    begin
      Result := FGetShortName(FileName);
      if not IsFileAccessed(Result) then
        Result := '';
    end;
  end;
end;


function FFindFirstFile(const DirName, Mask: WideString): WideString;
var
  h: THandle;
  fdA: TWin32FindDataA;
  fdW: TWin32FindDataW;
  IsDir: Boolean;
begin
  Result := '';
  h := INVALID_HANDLE_VALUE;
  try
    if Win32Platform = VER_PLATFORM_WIN32_NT then
    begin
      h := FindFirstFileW(PWideChar(DirName + '\' + Mask), fdW);
      if h <> INVALID_HANDLE_VALUE then
        repeat
          IsDir := (fdW.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0;
          if not IsDir then
          begin
            Result := DirName + '\' + fdW.cFileName;
            Exit
          end;
        until not FindNextFileW(h, fdW);
    end
    else
    begin
      h := FindFirstFileA(PAnsiChar(AnsiString(DirName+'\'+Mask)), fdA);
      if h <> INVALID_HANDLE_VALUE then
        repeat
          IsDir := (fdA.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0;
          if not IsDir then
          begin
            Result := DirName + '\' + fdA.cFileName;
            Exit
          end;
        until not FindNextFileA(h, fdA);
    end;
  finally
    Windows.FindClose(h);
  end;
end;


function FDeleteToRecycleA(Handle: THandle; const FileName: AnsiString; ToRecycle: Boolean): Boolean;
var
  op: TSHFileOpStructA;
  sFrom: AnsiString;
begin
  sFrom := FileName + #0#0;
  FillChar(op, SizeOf(op), 0);
  op.Wnd := Handle;
  op.wFunc := FO_DELETE;
  op.pFrom := PChar(sFrom);
  op.fFlags := FOF_NOCONFIRMATION;
  if ToRecycle then
    op.fFlags := op.fFlags or FOF_ALLOWUNDO;
  Result := SHFileOperationA(op) = 0;
end;

function FDeleteToRecycleW(Handle: THandle; const FileName: WideString; ToRecycle: Boolean): Boolean;
var
  op: TSHFileOpStructW;
  sFrom: WideString;
begin
  sFrom := FileName + #0#0;
  FillChar(op, SizeOf(op), 0);
  op.Wnd := Handle;
  op.wFunc := FO_DELETE;
  op.pFrom := PWideChar(sFrom);
  op.fFlags := FOF_NOCONFIRMATION;
  if ToRecycle then
    op.fFlags := op.fFlags or FOF_ALLOWUNDO;
  Result := SHFileOperationW(op) = 0;
end;

function FDeleteToRecycle(Handle: THandle; const FileName: WideString; ToRecycle: Boolean = True): Boolean;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    Result := FDeleteToRecycleW(Handle, FileName, ToRecycle)
  else
    Result := FDeleteToRecycleA(Handle, FileName, ToRecycle);
end;


function FGetFullPathName(const FileName: WideString): WideString;
var
  bufA: array[0 .. MAX_PATH - 1] of AnsiChar;
  bufW: array[0 .. MAX_PATH - 1] of WideChar;
  partA: PAnsiChar;
  partW: PWideChar;
begin
  Result := '';
  if FileName <> '' then //Result for empty string should be empty string!
    if Win32Platform = VER_PLATFORM_WIN32_NT then
    begin
      if GetFullPathNameW(PWideChar(FileName), SizeOf(bufW) div 2, bufW, partW) <> 0 then
        Result := bufW;
    end
    else
    begin
      if GetFullPathNameA(PAnsiChar(AnsiString(FileName)), SizeOf(bufA), bufA, partA) <> 0 then
        Result := AnsiString(bufA);
    end;
end;


procedure FShowPropertiesA(const fn: AnsiString; hWnd: THandle);
var
  sei: TShellExecuteInfoA;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := SizeOf(sei);
  sei.wnd := hWnd;
  sei.lpFile := PChar(fn);
  sei.lpVerb := 'properties';
  sei.fMask := SEE_MASK_INVOKEIDLIST;
  ShellExecuteExA(@sei);
end;

procedure FShowPropertiesW(const fn: WideString; hWnd: THandle);
var
  sei: TShellExecuteInfoW;
begin
  FillChar(sei, SizeOf(sei), 0);
  sei.cbSize := SizeOf(sei);
  sei.wnd := hWnd;
  sei.lpFile := PWChar(fn);
  sei.lpVerb := 'properties';
  sei.fMask := SEE_MASK_INVOKEIDLIST;
  ShellExecuteExW(@sei);
end;

procedure FShowProperties(const fn: WideString; hWnd: THandle);
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    FShowPropertiesW(fn, hWnd)
  else
    FShowPropertiesA(AnsiString(fn), hWnd);
end;


end.