Check-in [5ef23ab11e]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Show the file's attributes in the info window, and (if applicable) the target of the reparse point.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | feature/windows-preview-host
Files: files | file ages | folders
SHA1:5ef23ab11e57ce3f96eb39173f0efb3d849f7b87
User & Date: Martijn 2015-02-15 19:40:09
Context
2015-02-15
20:11
Added context menu to copy values or the entire list to clipboard. Reduced transparency of tool windows. check-in: cc23c098f0 user: Martijn tags: feature/windows-preview-host
19:40
Show the file's attributes in the info window, and (if applicable) the target of the reparse point. check-in: 5ef23ab11e user: Martijn tags: feature/windows-preview-host
18:13
Refactored TCustomPreviewEngineForm etc. to allow for adding and removing renderers after initialization. Finished adding WLX plugin support. check-in: 527809fb86 user: Martijn tags: feature/windows-preview-host
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added ZPreview/src/Delphi/Common/FJunction.pas.































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
//{$define DEBUG} //For debugging purposes: logs error messages to console.

unit FJunction;

interface

type
  TReparsePointType = (
    slUnknown,
    slJunction,
    slMountPoint,
    slSymLink,
    slHSM,
    slSIS,
    slDFS
    );

const
  SReparsePointType: array[TReparsePointType] of PChar = (
    'Unknown point type',
    'Junction',
    'Mount Point',
    'Symbolic Link',
    'Hierarchical Storage Management point',
    'Single Instance Store point',
    'Distributed File System point'
    );

function FCreateSymlink(const fnLink, fnTarget: WideString): boolean;
function FGetSymlinkInfo(const fn: WideString; var Target: WideString; var LinkType: TReparsePointType): boolean;
function FDeleteSymlink(const fn: WideString): boolean;
function FDriveSupportsSymlinks(const fn: WideString): boolean;


implementation

uses
  Windows, SysUtils, FProc;

const
  cDelaySleep = 500; //Small delay before removing a directory


//-------------------------------------------------------------
const
  MAX_REPARSE_SIZE = 17000;
  MAX_NAME_LENGTH = 1024;

  FILE_DEVICE_FILE_SYSTEM = $0009;

  METHOD_BUFFERED   = 0;
  METHOD_IN_DIRECT  = 1;
  METHOD_OUT_DIRECT = 2;
  METHOD_NEITHER    = 3;

  FILE_ANY_ACCESS = 0;
  FILE_READ_DATA  = 1;
  FILE_WRITE_DATA = 2;

  //#define FSCTL_SET_REPARSE_POINT         CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_WRITE_DATA)
  //#define FSCTL_GET_REPARSE_POINT         CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS)
  //#define FSCTL_DELETE_REPARSE_POINT      CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_WRITE_DATA)
  FSCTL_SET_REPARSE_POINT    = (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or (41 shl 2) or (METHOD_BUFFERED);
  FSCTL_GET_REPARSE_POINT    = (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or (42 shl 2) or (METHOD_BUFFERED);
  FSCTL_DELETE_REPARSE_POINT = (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or (43 shl 2) or (METHOD_BUFFERED);

  FILE_FLAG_OPEN_REPARSE_POINT = $00200000;

  IO_REPARSE_TAG_RESERVED_ZERO  = $000000000;
  IO_REPARSE_TAG_SYMBOLIC_LINK  = IO_REPARSE_TAG_RESERVED_ZERO;
  IO_REPARSE_TAG_RESERVED_ONE   = $000000001;
  IO_REPARSE_TAG_RESERVED_RANGE = $000000001;
  IO_REPARSE_TAG_VALID_VALUES   = $0E000FFFF;
  IO_REPARSE_TAG_HSM            = $0C0000004;
  IO_REPARSE_TAG_NSS            = $080000005;
  IO_REPARSE_TAG_NSSRECOVER     = $080000006;
  IO_REPARSE_TAG_SIS            = $080000007;
  IO_REPARSE_TAG_DFS            = $080000008;
  IO_REPARSE_TAG_MOUNT_POINT    = $0A0000003;

  REPARSE_MOUNTPOINT_HEADER_SIZE = 8;

  FILE_SUPPORTS_REPARSE_POINTS = $00000080;

type
  REPARSE_MOUNTPOINT_DATA_BUFFER = packed record
    ReparseTag: DWORD;
    ReparseDataLength: DWORD;
    Reserved: Word;
    ReparseTargetLength: Word;
    ReparseTargetMaximumLength: Word;
    Reserved1: Word;
    ReparseTarget: array[0..0] of WideChar;
  end;
  TReparseMountPointDataBuffer = REPARSE_MOUNTPOINT_DATA_BUFFER;
  PReparseMountPointDataBuffer = ^TReparseMountPointDataBuffer;

  REPARSE_DATA_BUFFER = packed record
    ReparseTag: DWORD;
    ReparseDataLength: Word;
    Reserved: Word;
    SubstituteNameOffset: Word;
    SubstituteNameLength: Word;
    PrintNameOffset: Word;
    PrintNameLength: Word;
    PathBuffer: array[0..0] of WideChar;
  end;
  TReparseDataBuffer = REPARSE_DATA_BUFFER;
  PReparseDataBuffer = ^TReparseDataBuffer;

//-------------------------------------------------------------
procedure Log(const S: string);
begin
  {$ifdef DEBUG}
  Writeln(S);
  {$endif}
end;

//-------------------------------------------------------------
const
  cNTPrefix: WideString = '\??\';

function FCreateSymlink_NT(const fnLink, fnTarget: WideString): boolean;
var
  h: THandle;
  Buffer: PReparseMountPointDataBuffer;
  BufSize: integer;
  TargetName: WideString;
  BytesRead: DWORD;
begin
  Result:= false;
  if IsFileExist(fnLink) then
    begin
    Log('Target already exists');
    Exit
    end;
  if not CreateDirectoryW(PWideChar(fnLink), nil) then
    begin
    Log('CreateDirectoryW failed');
    Exit
    end;

  h:= CreateFileW(PWideChar(fnLink), GENERIC_WRITE, 0, nil, OPEN_EXISTING,
    FILE_FLAG_OPEN_REPARSE_POINT or FILE_FLAG_BACKUP_SEMANTICS, 0);
  if h=INVALID_HANDLE_VALUE then
    begin
    Log('CreateFileW failed');
    RemoveDirectoryW(PWideChar(fnLink));
    Exit
    end;

  TargetName:= cNTPrefix+fnTarget;
  BufSize:= (Length(cNTPrefix)+Length(fnTarget)+1)*2+REPARSE_MOUNTPOINT_HEADER_SIZE+12;
  GetMem(Buffer, BufSize);
  FillChar(Buffer^, BufSize, 0);

  with Buffer^ do
    begin
    Move(TargetName[1], ReparseTarget, (Length(TargetName)+1)*2);
    ReparseTag:= IO_REPARSE_TAG_MOUNT_POINT;
    ReparseTargetLength:= Length(TargetName)*2;
    ReparseTargetMaximumLength:= ReparseTargetLength+2;
    ReparseDataLength:= ReparseTargetLength+12;
    end;

  {
  with Buffer^ do
    begin
    Writeln('Reparse info:');
    Writeln('ReparseTargetLength: ', ReparseTargetLength);
    Writeln('ReparseTarget: "', string(ReparseTarget), '"');
    end;
    }

  BytesRead:= 0;
  Result:= DeviceIoControl(h, FSCTL_SET_REPARSE_POINT,
    Buffer, Buffer^.ReparseDataLength+REPARSE_MOUNTPOINT_HEADER_SIZE, nil, 0,
    BytesRead, nil);
  if not Result then
    begin
    Log('DeviceIoControl failed');
    Sleep(cDelaySleep); //for RemoveDirectoryW to work
    RemoveDirectoryW(PWideChar(fnLink));
    end;

  FreeMem(Buffer);
  CloseHandle(h);
end;


//-------------------------------------------------------------
function FCreateSymlink_Vista(const fnLink, fnTarget: WideString): boolean;
var
  hLib: THandle;
  Proc: TCreateSymbolicLink;
begin
  Result:= false;

  hLib:= GetModuleHandle('kernel32.dll');
  if hLib = 0 then
    begin Log('GetModuleHandle failed'); Exit end;

  @Proc:= GetProcAddress(hLib, 'CreateSymbolicLinkW');
  if not Assigned(Proc) then
    begin Log('GetProcAddress failed'); Exit end;

  Result:= Proc(PWideChar(fnLink), PWideChar(fnTarget), SYMBOLIC_LINK_FLAG_DIRECTORY);
end;


//-------------------------------------------------------------
function FCreateSymlink(const fnLink, fnTarget: WideString): boolean;
begin
  if IsWindowsVista then
    Result:= FCreateSymlink_Vista(fnLink, fnTarget)
  else
    Result:= FCreateSymlink_NT(fnLink, fnTarget);
end;


//-------------------------------------------------------------
procedure SDeletePrefix(var S: WideString; const Prefix: WideString);
begin
  if Pos(Prefix, S) = 1 then
    Delete(S, 1, Length(Prefix));
end;

//-------------------------------------------------------------
function FGetSymlinkInfo_Vista(const fn: WideString; var Target: WideString): boolean;
var
  hLib, hDir: THandle;
  nRes: DWORD;
  Proc: TGetFinalPathNameByHandleW;
  Buffer: array[0 .. 16 * 1024 - 1] of WideChar;
begin
  Result:= false;
  Target:= '';

  hLib:= GetModuleHandle('kernel32.dll');
  if hLib = 0 then
    begin Log('GetModuleHandle failed'); Exit end;

  @Proc:= GetProcAddress(hLib, 'GetFinalPathNameByHandleW');
  if not Assigned(Proc) then
    begin Log('GetProcAddress failed'); Exit end;

  hDir:= CreateFileW(PWideChar(fn), 0, 0, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
  if hDir = INVALID_HANDLE_VALUE then
    begin Log('CreateFile failed'); Exit end;

  try
    FillChar(Buffer, SizeOf(Buffer), 0);
    nRes:= Proc(hDir, Buffer, SizeOf(Buffer) div 2, FILE_NAME_NORMALIZED);

    if (nRes = 0) or (nRes >= SizeOf(Buffer) div 2) then
      begin Log('GetFinalPathByHandle failed'); Exit end;

    Result:= true;
    Target:= Buffer;
    SDeletePrefix(Target, '\\?\');
  finally
    CloseHandle(hDir);
  end;
end;


//-------------------------------------------------------------
function FGetSymlinkInfo_NT(const fn: WideString; var Target: WideString; var LinkType: TReparsePointType): boolean;
var
  attr: DWORD;
  h: THandle;
  reparseBuffer: array[0..MAX_REPARSE_SIZE-1] of char;
  reparseInfo: PReparseDataBuffer;
  reparseData: pointer;
  //reparseData1,
  reparseData2: PWideChar;
  //name1,
  name2: array[0..MAX_NAME_LENGTH-1] of WideChar;
  returnedLength: DWORD;
  control: boolean;
begin
  Result:= false;
  Target:= '';
  LinkType:= slUnknown;

  attr:= GetFileAttributesW(PWideChar(fn));

  if (attr=$FFFFFFFF) then
    begin
    Log('GetFileAttributes failed');
    Exit
    end;

  if (attr and FILE_ATTRIBUTE_REPARSE_POINT)=0 then
    begin
    Log('GetFileAttributes returned wrong result');
    Exit
    end;

  if (attr and FILE_ATTRIBUTE_DIRECTORY)<>0 then
    h:= CreateFileW(PWideChar(fn), 0,
      FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
      OPEN_EXISTING, 
      FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OPEN_REPARSE_POINT, 0)
  else
    h:= CreateFileW(PWideChar(fn), 0,
      FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
      OPEN_EXISTING,
      FILE_FLAG_OPEN_REPARSE_POINT, 0);

  if h=INVALID_HANDLE_VALUE then
    begin
    Log('CreateFileW failed');
    Exit
    end;

  reparseInfo:= @reparseBuffer;
  control:= DeviceIoControl(h, FSCTL_GET_REPARSE_POINT,
    nil, 0, reparseInfo, SizeOf(reparseBuffer),
    returnedLength, nil);
  CloseHandle(h);
  if not control then
    begin
    Log('DeviceIoControl failed');
    Exit
    end;

  case reparseInfo^.ReparseTag of
    IO_REPARSE_TAG_MOUNT_POINT:
      begin
      reparseData:= @reparseInfo.PathBuffer;

      {
      FillChar(name1, SizeOf(name1), 0);
      reparseData1:= pointer(integer(reparseData)+reparseInfo.PrintNameOffset);
      lstrcpynW(name1, reparseData1, reparseInfo.PrintNameLength);
      }

      FillChar(name2, SizeOf(name2), 0);
      reparseData2:= pointer(integer(reparseData)+reparseInfo.SubstituteNameOffset);
      lstrcpynW(name2, reparseData2, reparseInfo.SubstituteNameLength);

      Target:= name2;
      SDeletePrefix(Target, cNTPrefix);

      if Pos(':', Target)>0
        then LinkType:= slJunction
        else LinkType:= slMountPoint;

      Result:= true;
      end;

    IO_REPARSE_TAG_SYMBOLIC_LINK or $80000000:
      begin
      reparseData:= @reparseInfo.PathBuffer;

      {
      FillChar(name1, SizeOf(name1), 0);
      reparseData1:= pointer(integer(reparseData)+reparseInfo.PrintNameOffset);
      lstrcpynW(name1, reparseData1, reparseInfo.PrintNameLength);
      }

      FillChar(name2, SizeOf(name2), 0);
      reparseData2:= pointer(integer(reparseData)+reparseInfo.SubstituteNameOffset);
      lstrcpynW(name2, reparseData2, reparseInfo.SubstituteNameLength);

      Target:= name2;
      LinkType:= slSymLink;
      Result:= true;
      end;

    IO_REPARSE_TAG_HSM:
      begin
      LinkType:= slHSM;
      Result:= true;
      end;

    IO_REPARSE_TAG_SIS:
      begin
      LinkType:= slSIS;
      Result:= true;
      end;

    IO_REPARSE_TAG_DFS:
      begin
      LinkType:= slDFS;
      Result:= true;
      end;
  end;
end;


//-------------------------------------------------------------
function FGetSymlinkInfo(const fn: WideString; var Target: WideString; var LinkType: TReparsePointType): boolean;
begin
  if IsWindowsVista then
  begin
    Result:= FGetSymlinkInfo_Vista(fn, Target);
    LinkType:= slJunction;
  end
  else
    Result:= FGetSymlinkInfo_NT(fn, Target, LinkType);
end;


//-------------------------------------------------------------
function FDeleteSymlink(const fn: WideString): boolean;
begin
  Result:= RemoveDirectoryW(PWideChar(fn));
end;


//-------------------------------------------------------------
function FDriveSupportsSymlinks(const fn: WideString): boolean;
var
  disk: char;
  buf1, buf2: array[0..50] of char;
  Serial, NameLen, Flags: DWORD;
begin
  Result:= false;
  if (fn='') or (Pos(':\', string(fn))<>2) then Exit;
  disk:= char(fn[1]);
  FillChar(buf1, SizeOf(buf1), 0);
  FillChar(buf2, SizeOf(buf2), 0);
  if GetVolumeInformation(PChar(disk+':\'), @buf1, SizeOf(buf1),
    @Serial, NameLen, Flags, @buf2, SizeOf(buf2)) then
    Result:= (Flags and FILE_SUPPORTS_REPARSE_POINTS)<>0;
end;


end.

Added ZPreview/src/Delphi/Common/FProc.pas.















































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
unit FProc;

interface

uses
  Windows;

function IsFileExist(const fn: WideString): boolean; overload;
function IsFileExist(const fn: WideString; var IsDir: boolean): boolean; overload;
function IsDirExist(const fn: WideString): boolean;
function FFullName(const fn: WideString; var fnOut: WideString): boolean;

function ToOEM(const s: string): AnsiString;
function ToANSI(const s: AnsiString): string;

const
  FILE_ATTRIBUTE_DEVICE               = $00000040;
  FILE_ATTRIBUTE_SPARSE_FILE          = $00000200;
  FILE_ATTRIBUTE_REPARSE_POINT        = $00000400;
  FILE_ATTRIBUTE_OFFLINE              = $00001000;
  FILE_ATTRIBUTE_NOT_CONTENT_INDEXED  = $00002000;
  FILE_ATTRIBUTE_ENCRYPTED            = $00004000;

type
  TGetFinalPathNameByHandleW = function(
    hFile: THandle;
    FilePath: PWideChar;
    FilePathSize: DWORD;
    Flags: DWORD): DWORD; stdcall;

type
  TCreateSymbolicLink = function(
    SymlinkFileName,
    TargetFileName: PWideChar;
    Flags: DWORD): BOOL; stdcall;

const
  FILE_NAME_NORMALIZED = 0;
  SYMBOLIC_LINK_FLAG_DIRECTORY = $1;


function IsWindowsVista: boolean;
function SFormatLastError(ErrorCode: DWORD): WideString;


implementation

uses
  SysUtils;

//----------------------------------------------
function IsFileExist(const fn: WideString; var IsDir: boolean): boolean;
var
  h: THandle;
  fdA: TWin32FindDataA;
  fdW: TWin32FindDataW;
begin
  Result:= false;
  IsDir:= false;
  if fn='' then Exit;

  if Win32Platform = VER_PLATFORM_WIN32_NT then
    begin
    h:= FindFirstFileW(PWideChar(fn), fdW);
    Result:= h <> INVALID_HANDLE_VALUE;
    if Result then
      begin
      IsDir:= (fdW.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0;
      Windows.FindClose(h);
      end;
    end
  else
    begin
    h:= FindFirstFileA(PAnsiChar(AnsiString(fn)), fdA);
    Result:= h <> INVALID_HANDLE_VALUE;
    if Result then
      begin
      IsDir:= (fdA.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0;
      Windows.FindClose(h);
      end;
    end;
end;

//----------------------------------------------
function IsFileExist(const fn: WideString): boolean;
var
  IsDir: boolean;
begin
  Result:= IsFileExist(fn, IsDir);
end;

function IsDirExist(const fn: WideString): boolean;
var
  IsDir: boolean;
begin
  Result:= IsFileExist(fn, IsDir) and IsDir;
end;

//----------------------------------------------
function FFullName(const fn: WideString; var fnOut: WideString): boolean;
var
  bufA: array[0 .. MAX_PATH - 1] of AnsiChar;
  bufW: array[0 .. MAX_PATH - 1] of WideChar;
  partA: PAnsiChar;
  partW: PWideChar;
begin
  fnOut:= '';
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    begin
    FillChar(bufW, SizeOf(bufW), 0);
    Result:= GetFullPathNameW(PWideChar(fn), SizeOf(bufW) div 2, bufW, partW) <> 0;
    if Result then
      fnOut:= bufW;
    end
  else
    begin
    FillChar(bufA, SizeOf(bufA), 0);
    Result:= GetFullPathNameA(PAnsiChar(Ansistring(fn)), SizeOf(bufA), bufA, partA) <> 0;
    if Result then
      fnOut:= WideString(AnsiString(bufA));
    end;
end;

//----------------------------------------------
function ToOEM(const s: string): Ansistring;
begin
  SetLength(Result, Length(s));
  CharToOemBuff(PChar(s), PAnsiChar(Result), Length(s));
end;

function ToANSI(const s: AnsiString): string;
begin
  SetLength(Result, Length(s));
  OemToCharBuff(PAnsiChar(s), PWideChar(Result), Length(s));
end;

//----------------------------------------------
function IsWindowsVista: boolean;
begin
  Result:=
    (Win32Platform = VER_PLATFORM_WIN32_NT) and
    (Win32MajorVersion >= 6);
end;

//----------------------------------------------
function SFormatLastError(ErrorCode: DWORD): WideString;
var
  bufA: array[0..500] of AnsiChar;
  bufW: array[0..500] of WideChar;
begin
  Result:= '';
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    begin
    if FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
      nil, ErrorCode, 0, bufW, SizeOf(bufW) div 2, nil)>0 then
      Result:= bufW;
    end
  else
    begin
    if FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
      nil, ErrorCode, 0, bufA, SizeOf(bufA), nil)>0 then
      Result:= string(bufA);
    end;
end;


end.

Changes to ZPreview/src/Delphi/F_Info.pas.

37
38
39
40
41
42
43

44

45
46
47
48
49
50
51
...
109
110
111
112
113
114
115







































116


















117
118





119
120
121
122
123
124
125
var
  frmInfo: TfrmInfo;

implementation

uses
  SysUtils, System.TypInfo,

  Vcl.Imaging.GIFImg, Vcl.Imaging.jpeg, Vcl.Imaging.pngimage,

  F_Main;

{$R *.dfm}

{ ================================================================================================ }
{ TfrmInfo }

................................................................................
procedure TfrmInfo.Add(const Group, Name: string; const Value: Integer; const Names: array of string);
begin
  Add(Group, Name, IntToStr(Value), Names[Value]);
end {TfrmInfo.Add};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmInfo.PopulateFileName(const Filename: string);







































begin


















  Add(Filename, 'File name', ExtractFileName(Filename));
  Add(Filename, 'File path', ExtractFilePath(Filename));





end {TfrmInfo.PopulateFileName};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmInfo.PopulateLine(const Group, Key, Short, Long: string);
var
  Item: TListItem;
begin







>

>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>
>
>
>
>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
...
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
var
  frmInfo: TfrmInfo;

implementation

uses
  SysUtils, System.TypInfo,
  Winapi.Windows,
  Vcl.Imaging.GIFImg, Vcl.Imaging.jpeg, Vcl.Imaging.pngimage,
  FJunction,
  F_Main;

{$R *.dfm}

{ ================================================================================================ }
{ TfrmInfo }

................................................................................
procedure TfrmInfo.Add(const Group, Name: string; const Value: Integer; const Names: array of string);
begin
  Add(Group, Name, IntToStr(Value), Names[Value]);
end {TfrmInfo.Add};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmInfo.PopulateFileName(const Filename: string);
const
//  csAttr: array[Boolean] of string = ('drashceijnoptuv',
//                                      'DRASHCEIJNOPTUV');
  csAttr: array[Boolean] of string = ('иииииииииииииии',
                                      'drashceijnoptuv');
  cAttr: array[1..15] of integer = (FILE_ATTRIBUTE_DIRECTORY,
                                    FILE_ATTRIBUTE_READONLY,
                                    FILE_ATTRIBUTE_ARCHIVE,
                                    FILE_ATTRIBUTE_SYSTEM,
                                    FILE_ATTRIBUTE_HIDDEN,
                                    FILE_ATTRIBUTE_COMPRESSED,
                                    FILE_ATTRIBUTE_ENCRYPTED,
                                    FILE_ATTRIBUTE_NOT_CONTENT_INDEXED,
                                    FILE_ATTRIBUTE_REPARSE_POINT,
                                    FILE_ATTRIBUTE_NORMAL,
                                    FILE_ATTRIBUTE_OFFLINE,
                                    FILE_ATTRIBUTE_SPARSE_FILE,
                                    FILE_ATTRIBUTE_TEMPORARY,
                                    FILE_ATTRIBUTE_VIRTUAL,
                                    FILE_ATTRIBUTE_DEVICE);
  csAttrName: array[1..15] of string = ('directory',
                                        'readonly',
                                        'archive',
                                        'system',
                                        'hidden',
                                        'compressed',
                                        'encrypted',
                                        'not content indexed',
                                        'reparse point',
                                        'normal',
                                        'offline',
                                        'sparse file',
                                        'temporary',
                                        'virtual',
                                        'device');
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  function GetAttributesString(const Attr: Integer): string;
  var
    i: Integer;
  begin
    for i := Low(cAttr) to High(cAttr) do begin
      if (Attr and cAttr[i]) <> 0 then begin
        if Length(Result) > 0 then
          Result := Result + ', ';
        Result := Result + csAttrName[i];
      end;
    end;
    Result := StringOfChar('.', Length(cAttr)) + ' [' + Result + ']';
    for i := Low(cAttr) to High(cAttr) do begin
      Result[i] := csAttr[(Attr and cAttr[i]) <> 0][i];
    end;
  end {GetAttributesString};
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
var
  Attr: Integer;
  Target: WideString;
  LinkType: TReparsePointType;
begin
  Add(Filename, 'File name', ExtractFileName(Filename));
  Add(Filename, 'File path', ExtractFilePath(Filename));
  Attr := FileGetAttr(FileName, False);
  Add(Filename, 'Attributes', '0x' + IntToHex(Attr, 2), GetAttributesString(Attr));
  if ((Attr and faSymLink) <> 0) and FJunction.FGetSymlinkInfo(Filename, Target, LinkType) then begin
    Add(Filename, SReparsePointType[LinkType] + ' target', Target);
  end;
end {TfrmInfo.PopulateFileName};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmInfo.PopulateLine(const Group, Key, Short, Long: string);
var
  Item: TListItem;
begin

Changes to ZPreview/src/Delphi/ZPreview.dproj.

36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
51
52
53
54
55
    </PropertyGroup>
    <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
        <Cfg_2>true</Cfg_2>
        <CfgParent>Base</CfgParent>
        <Base>true</Base>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base)'!=''">
        <OutputExt>32.exe</OutputExt>

        <VerInfo_Release>1</VerInfo_Release>
        <VerInfo_PreRelease>true</VerInfo_PreRelease>
        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
        <VerInfo_Locale>1033</VerInfo_Locale>
        <DCC_UnitSearchPath>ZAAP;FreeImage;Plugins;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
        <Icon_MainIcon>ZPreview_Icon.ico</Icon_MainIcon>
        <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
        <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
        <SanitizedProjectName>ZPreview</SanitizedProjectName>
        <VerInfo_Keys>CompanyName=Martijn Coppoolse;FileDescription=ZTreeWin Preview Assistant Application;FileVersion=1.0.1.0;InternalName=ZPreview;LegalCopyright=;LegalTrademarks=;OriginalFilename=ZPreview.exe;ProductName=ZPreview;ProductVersion=1.0;Comments=http://fossil.2of4.net/zaap/</VerInfo_Keys>
        <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
        <DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>







|
>




|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
    </PropertyGroup>
    <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
        <Cfg_2>true</Cfg_2>
        <CfgParent>Base</CfgParent>
        <Base>true</Base>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base)'!=''">
        <DCC_SYMBOL_PLATFORM>false</DCC_SYMBOL_PLATFORM>
        <DCC_UNIT_PLATFORM>false</DCC_UNIT_PLATFORM>
        <VerInfo_Release>1</VerInfo_Release>
        <VerInfo_PreRelease>true</VerInfo_PreRelease>
        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
        <VerInfo_Locale>1033</VerInfo_Locale>
        <DCC_UnitSearchPath>ZAAP;FreeImage;Plugins;Common;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
        <Icon_MainIcon>ZPreview_Icon.ico</Icon_MainIcon>
        <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
        <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
        <SanitizedProjectName>ZPreview</SanitizedProjectName>
        <VerInfo_Keys>CompanyName=Martijn Coppoolse;FileDescription=ZTreeWin Preview Assistant Application;FileVersion=1.0.1.0;InternalName=ZPreview;LegalCopyright=;LegalTrademarks=;OriginalFilename=ZPreview.exe;ProductName=ZPreview;ProductVersion=1.0;Comments=http://fossil.2of4.net/zaap/</VerInfo_Keys>
        <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
        <DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>