Subversion Repositories checksum-tools

Rev

Rev 6 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit LongFilenameOperations;
  2.  
  3. interface
  4.  
  5. // These procedures should replace the Delphi internal AssignFile(), Reset(), etc.
  6. // functions. These functions should be able to support long file names
  7. // by using the WinAPI (the "long filename" mode is switched when the file
  8. // name format \\?\ is used).
  9.  
  10. procedure MyAssignFile(var hFile: THandle; filename: string);
  11. procedure MyReset(hFile: THandle);
  12. procedure MyRewrite(hFile: THandle);
  13. procedure MyWriteLn(hFile: THandle; s: AnsiString);
  14. procedure MyReadLn(hFile: THandle; var s: string);
  15. procedure MyCloseFile(hFile: THandle);
  16. function MyEOF(hFile: THandle): boolean;
  17. procedure MyBlockRead(var hFile: THandle; var Buffer; RecordCount: integer; var RecordsRead: integer);
  18.  
  19. implementation
  20.  
  21. uses
  22.   Windows, SysUtils;
  23.  
  24. procedure MyAssignFile(var hFile: THandle; filename: string);
  25. var
  26.   lastErr: DWORD;
  27. begin
  28.   if Copy(filename, 2, 1) = ':' then filename := '\\?\' + filename; // To allow long filenames
  29.   hFile := CreateFile(PChar(filename), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_READONLY, 0);
  30.   if hFile = INVALID_HANDLE_VALUE then
  31.   begin
  32.     lastErr := GetLastError;
  33.     if lastErr = ERROR_ACCESS_DENIED then
  34.     begin
  35.       hFile := CreateFile(PChar(filename), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_READONLY, 0);
  36.       if hFile = INVALID_HANDLE_VALUE then RaiseLastOSError;
  37.     end
  38.     else RaiseLastOSError(lastErr);
  39.   end;
  40. end;
  41.  
  42. procedure MyReset(hFile: THandle);
  43. begin
  44.   SetFilePointer(hFile, 0, nil, FILE_BEGIN);
  45. end;
  46.  
  47. procedure MyRewrite(hFile: THandle);
  48. begin
  49.   SetFilePointer(hFile, 0, nil, FILE_BEGIN);
  50.   SetEndOfFile(hFile);
  51. end;
  52.  
  53. procedure MyWriteLn(hFile: THandle; s: AnsiString);
  54. var
  55.   numWritten: Cardinal;
  56. begin
  57.   s := s + #13#10;
  58.   WriteFile(hFile, s[1], Length(s), numWritten, nil);
  59.   if Cardinal(Length(s)) <> numWritten then RaiseLastOSError;
  60. end;
  61.  
  62. procedure MyReadLn(hFile: THandle; var s: string);
  63. var
  64.   buf: array [0..0] of ansichar;
  65.   dwread: LongWord;
  66. begin
  67.   s := '';
  68.   ReadFile(hFile, buf, 1, dwread, nil);
  69.   while (dwread > 0) do
  70.   begin
  71.     if buf[0] <> #13 then // Note: The first line of SFV files contains a comment ended with LF while the other lines end with CR-LF
  72.     begin
  73.       if buf[0] = #10 then exit;
  74.       s := s + string(buf[0]);
  75.     end;
  76.     Readfile(hFile, buf, 1, dwread, nil);
  77.   end;
  78. end;
  79.  
  80. procedure MyCloseFile(hFile: THandle);
  81. begin
  82.   CloseHandle(hFile);
  83. end;
  84.  
  85. function MyEOF(hFile: THandle): boolean;
  86. var
  87.   buf: array [0..0] of ansichar;
  88.   dwread: LongWord;
  89. begin
  90.   Readfile(hFile, buf, 1, dwread, nil);
  91.   if dwread > 0 then
  92.   begin
  93.     SetFilePointer(hFile, -dwread, nil, FILE_CURRENT);
  94.     result := false;
  95.   end
  96.   else
  97.   begin
  98.     result := true;
  99.   end;
  100. end;
  101.  
  102. procedure MyBlockRead(var hFile: THandle; var Buffer; RecordCount: integer; var RecordsRead: integer);
  103. var
  104.   RecordCount2, RecordsRead2: Cardinal;
  105. begin
  106.   RecordCount2 := RecordCount;
  107.   RecordsRead2 := RecordsRead;
  108.   ReadFile(hFile, Buffer, RecordCount2, RecordsRead2, nil);
  109.   //RecordCount := RecordCount2;
  110.   RecordsRead := RecordsRead2;
  111. end;
  112.  
  113. end.
  114.