Subversion Repositories checksum-tools

Rev

Rev 3 | Go to most recent revision | 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);
25 
begin
6 daniel-mar 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;
2 daniel-mar 36 
end;
37 
 
38 
procedure MyReset(hFile: THandle);
39 
begin
40 
  SetFilePointer(hFile, 0, nil, FILE_BEGIN);
41 
end;
42 
 
6 daniel-mar 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 
 
2 daniel-mar 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
3 daniel-mar 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
2 daniel-mar 68 
    begin
3 daniel-mar 69 
      if buf[0] = #10 then exit;
2 daniel-mar 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.