Subversion Repositories checksum-tools

Rev

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

Rev Author Line No. Line
2 daniel-mar 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);
6 daniel-mar 12 
procedure MyRewrite(hFile: THandle);
13 
procedure MyWriteLn(hFile: THandle; s: AnsiString);
2 daniel-mar 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);
17 daniel-mar 25 
var
26 
  lastErr: DWORD;
2 daniel-mar 27 
begin
17 daniel-mar 28 
  if Copy(filename, 2, 1) = ':' then filename := '\\?\' + filename; // To allow long filenames
6 daniel-mar 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
17 daniel-mar 32 
    lastErr := GetLastError;
33 
    if lastErr = ERROR_ACCESS_DENIED then
6 daniel-mar 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
17 daniel-mar 38 
    else RaiseLastOSError(lastErr);
6 daniel-mar 39 
  end;
2 daniel-mar 40 
end;
41 
 
42 
procedure MyReset(hFile: THandle);
43 
begin
44 
  SetFilePointer(hFile, 0, nil, FILE_BEGIN);
45 
end;
46 
 
6 daniel-mar 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 
 
2 daniel-mar 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
3 daniel-mar 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
2 daniel-mar 72 
    begin
3 daniel-mar 73 
      if buf[0] = #10 then exit;
2 daniel-mar 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.