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

unit msgpack;

interface

uses crt, dos, overlay,  common;

procedure packbase(fn : astr; maxm : longint);

implementation

uses mail0;

procedure packbase(fn : astr; maxm : longint);

var
    brdf1,brdf2 : file;
    buffer : array[1..4096] of char;
    msghdrf1,msghdrf2 : file of mheaderrec;
    mheader : mheaderrec;
    numm,i,idx,totload,buffered : word;
    needpack : boolean;

  procedure ohshit;
  begin
    sysoplog('error renaming temp files while packing.');
  end;

begin
  needpack := FALSE;
  fn := allcaps(fn);
  fn := general.msgpath + fn;

  assign(brdf1,fn+'.DAT');
  reset(brdf1,1);
  if (ioresult <> 0) then
    exit;

  assign(msghdrf1,fn+'.HDR');
  reset(msghdrf1);

  if ioresult<>0 then
     begin
       close(brdf1);
       exit
     end;

  if (maxm <> 0) and (filesize(msghdrf1) > maxm) then begin
    numm := 0;
    idx := filesize(msghdrf1);
    while (idx > 0) do
      begin
        seek(msghdrf1,idx - 1);
        read(msghdrf1,mheader);
        if not (mdeleted in mheader.status) then inc(numm);

        if (numm>maxm) and not (permanent in mheader.status) then
           begin
             mheader.status := [mdeleted];
             seek(msghdrf1,idx - 1);
             write(msghdrf1,mheader);
           end;

        dec(idx);
      end;
  end else
    begin

      while (filepos(msghdrf1) < filesize(msghdrf1)) and (not needpack) do
        begin
           read(msghdrf1,mheader);
           if mdeleted in mheader.status then needpack:=TRUE;
        end;

      if not needpack then
        begin
          close(msghdrf1);
          close(brdf1);
          exit;
        end;
    end;

  Lasterror := IOResult;

  assign(brdf2,fn+'.DA1');
  rewrite(brdf2,1);

  assign(msghdrf2,fn+'.HD2');
  rewrite(msghdrf2);

  kill(fn+'.HD3');
  kill(fn+'.DA3');

  Lasterror := IOResult;

  i := 0;
  idx := 1;

  while (i <= filesize(msghdrf1) - 1) do
    begin
      seek(msghdrf1,i);
      read(msghdrf1,mheader);

      if (mheader.pointer - 1 + mheader.textsize > filesize(brdf1)) or
         (mheader.pointer < 1) then mheader.status := [mdeleted];

      if not (mdeleted in mheader.status) then
        begin
          inc(idx);
          seek(brdf1,mheader.pointer - 1);
          mheader.pointer := filesize(brdf2) + 1;

          write(msghdrf2,mheader);

          totload := 0;
          if mheader.textsize > 0 then
            while (mheader.textsize>0) do
              begin
                buffered := mheader.textsize;
                if buffered > 4096 then buffered := 4096;
                dec(mheader.textsize,buffered);
                blockread(brdf1,buffer[1],buffered);
                blockwrite(brdf2,buffer[1],buffered);
                Lasterror := IOResult;
              end;
        end;
        inc(i);
    end;

  Lasterror := IOResult;
  close(brdf1);
  close(brdf2);
  close(msghdrf1);
  close(msghdrf2);

  rename(brdf1,fn+'.DA3');                     { rename .DAT to .DA3 }

  If (IOResult <> 0) then                      { Didn't work, abort  }
    begin
      ohshit;
      exit;
    end;

  rename(brdf2,fn+'.DAT');                     { Rename .DA2 to .DAT }

  If (IOResult <> 0) then                      { Didn't work, abort  }
    begin
      ohshit;
      rename(brdf1,fn+'.DAT');                 { Rename .DA3 to .DAT }
      exit;
    end;

  rename(msghdrf1,fn+'.HD3');                  { Rename .HDR to .HD3 }

  If (IOResult <> 0) then                      { Didn't work, abort  }
    begin
      ohshit;
      erase(brdf2);                            { Erase .DA2          }
      rename(brdf1,fn+'.DAT');                 { Rename .DA3 to .DAT }
      exit;
    end;

  rename(msghdrf2,fn+'.HDR');                  { Rename .HD2 to .HDR }

  If (IOResult <> 0) then                      { Didn't work, abort  }
    begin
      ohshit;
      erase(brdf2);                            { Erase .DAT (new)    }
      erase(msghdrf2);                         { Erase .HD2 (new)    }
      rename(brdf1,fn+'.DAT');                 { Rename .DA3 to .DAT }
      rename(msghdrf1,fn+'.HDR');              { Rename .HD3 to .HDR }
      exit;
    end;

  erase(msghdrf1);
  erase(brdf1);
  Lasterror := IOResult;
end;

end.