renegade2k/file3.pas at master · devshane/renegade2k · GitHub

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
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}

unit file3;

interface

uses crt, dos, overlay, myio, common;

procedure recheck;

implementation

uses file0, file1;

procedure CheckFiles(x:integer; checkdiz:boolean);
var
  rn:integer;
  f:ulfrec;
  v:verbrec;
  f2:file;
  s:astr;
begin
  TempPause := FALSE;
  changefileboard(x);
  if (fileboard = x) then
    begin
      initfileboard;
      rn := 0;
      while (rn < filesize(DirFile)) and (not abort) do
        begin
          wkey;
          Lasterror := ioresult;
          read(DirFile, f);
          if exist(memuboard.ulpath + f.filename) then
            s := memuboard.ulpath + f.filename
          else
            s := memuboard.dlpath + f.filename;
          assign(f2, s);
          reset(f2,1);
          if (IOResult <> 0) then
            f.filestat := f.filestat + [isrequest]
          else
            begin
              f.filestat := f.filestat - [isrequest];
              f.blocks := filesize(f2) div 128;
              f.sizemod := filesize(f2) mod 128;
              close(f2);
            end;
          if (CheckDiz) and (DizExists(s)) then
            begin
              GetDiz(f, v);
              if (v.descr[1] <> '') then
                begin
                  if (f.vpointer = -1) then
                    f.vpointer := NewVPointer;
                end;
              writefv(rn, f, v);
            end;
          seek(DirFile, rn);
          write(DirFile, f);
          inc(rn);
         end;
       close(DirFile);
    end;
end;

procedure grecheck;
var
  oldboard:integer;
  checkdiz, oldconf:boolean;
  x:integer;
begin
  oldboard := fileboard;
  oldconf := confsystem;
  if (oldconf = TRUE) then
    newcomptables;
  x := 1;
  CheckDiz := pynq(^M^J'Reimport descriptions? ');
  nl;
  abort:=FALSE; next:=FALSE; TempPause := FALSE;
  while (not abort) and (x <= MaxFBases) and (not hangup) do
    begin
      if (cfbase(x) > 0) then
        begin
          loadfileboard(x);
          if aacs(memuboard.acs) then
            begin
              print('^1Checking ^5'+memuboard.name+' #'+cstr(cfbase(x))+'^1...');
              Checkfiles(x, CheckDiz);
            end;
          wkey;
          next:=FALSE;
        end;
        inc(x);
    end;
  confsystem := oldconf;
  if (oldconf = TRUE) then
    newcomptables;
  fileboard := oldboard;
  initfileboard;
end;

procedure recheck;
begin
  abort := FALSE;
  if pynq(^M^J'Recheck all directories? ') then
    grecheck
  else
    CheckFiles(fileboard, pynq(^M^J'Reimport descriptions? '));
end;

end.