Subversion Repositories checksum-tools

Rev

Rev 3 | Go to most recent revision | 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. begin
  26.   hFile := CreateFile(PChar(filename), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_READONLY, 0);
  27.   if hFile = INVALID_HANDLE_VALUE then
  28.   begin
  29.     if GetLastError = ERROR_ACCESS_DENIED then
  30.     begin
  31.       hFile := CreateFile(PChar(filename), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_READONLY, 0);
  32.       if hFile = INVALID_HANDLE_VALUE then RaiseLastOSError;
  33.     end
  34.     else RaiseLastOSError;
  35.   end;
  36. end;
  37.  
  38. procedure MyReset(hFile: THandle);
  39. begin
  40.   SetFilePointer(hFile, 0, nil, FILE_BEGIN);
  41. end;
  42.  
  43. procedure MyRewrite(hFile: THandle);
  44. begin
  45.   SetFilePointer(hFile, 0, nil, FILE_BEGIN);
  46.   SetEndOfFile(hFile);
  47. end;
  48.  
  49. procedure MyWriteLn(hFile: THandle; s: AnsiString);
  50. var
  51.   numWritten: Cardinal;
  52. begin
  53.   s := s + #13#10;
  54.   WriteFile(hFile, s[1], Length(s), numWritten, nil);
  55.   if Cardinal(Length(s)) <> numWritten then RaiseLastOSError;
  56. end;
  57.  
  58. procedure MyReadLn(hFile: THandle; var s: string);
  59. var
  60.   buf: array [0..0] of ansichar;
  61.   dwread: LongWord;
  62. begin
  63.   s := '';
  64.   ReadFile(hFile, buf, 1, dwread, nil);
  65.   while (dwread > 0) do
  66.   begin
  67.     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
  68.     begin
  69.       if buf[0] = #10 then exit;
  70.       s := s + string(buf[0]);
  71.     end;
  72.     Readfile(hFile, buf, 1, dwread, nil);
  73.   end;
  74. end;
  75.  
  76. procedure MyCloseFile(hFile: THandle);
  77. begin
  78.   CloseHandle(hFile);
  79. end;
  80.  
  81. function MyEOF(hFile: THandle): boolean;
  82. var
  83.   buf: array [0..0] of ansichar;
  84.   dwread: LongWord;
  85. begin
  86.   Readfile(hFile, buf, 1, dwread, nil);
  87.   if dwread > 0 then
  88.   begin
  89.     SetFilePointer(hFile, -dwread, nil, FILE_CURRENT);
  90.     result := false;
  91.   end
  92.   else
  93.   begin
  94.     result := true;
  95.   end;
  96. end;
  97.  
  98. procedure MyBlockRead(var hFile: THandle; var Buffer; RecordCount: integer; var RecordsRead: integer);
  99. var
  100.   RecordCount2, RecordsRead2: Cardinal;
  101. begin
  102.   RecordCount2 := RecordCount;
  103.   RecordsRead2 := RecordsRead;
  104.   ReadFile(hFile, Buffer, RecordCount2, RecordsRead2, nil);
  105.   //RecordCount := RecordCount2;
  106.   RecordsRead := RecordsRead2;
  107. end;
  108.  
  109. end.
  110.