src/shared/BinEditor.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE a_modes.inc}
  17 unit BinEditor;
  18
  19 interface
  20
  21 Uses
  22   SysUtils, Classes;
  23
  24 type
  25   EBinSizeError = class(Exception);
  26
  27   TBinMemoryWriter = class
  28   private
  29     FSize: LongWord;
  30     FData: Pointer;
  31     FPosition: LongWord;
  32
  33     procedure WriteVar (var x; varSize: LongWord);
  34     procedure ExtendMemory (addLen: LongWord);
  35
  36   public
  37     constructor Create (aSize: LongWord);
  38     destructor Destroy (); override;
  39
  40     procedure WriteByte (x: Byte);
  41     procedure WriteWord (x: Word);
  42     procedure WriteDWORD (x: LongWord);
  43     procedure WriteShortInt (x: ShortInt);
  44     procedure WriteSmallInt (x: SmallInt);
  45     procedure WriteInt (x: LongInt);
  46     procedure WriteSingle (x: Single);
  47     procedure WriteBoolean (x: Boolean);
  48     procedure WriteString (const x: AnsiString; aMaxLen: Word=65535);
  49     procedure WriteMemory (x: Pointer; memSize: LongWord);
  50     procedure Fill (aLen: LongWord; aFillSym: Byte);
  51     procedure SaveToFile (st: TStream);
  52     procedure SaveToMemory (aMem: TBinMemoryWriter);
  53   end;
  54
  55   TBinMemoryReader = class
  56   private
  57     FSize: LongWord;
  58     FData: Pointer;
  59     FPosition: LongWord;
  60
  61     procedure ReadVar (var x; varSize: LongWord);
  62
  63   public
  64     constructor Create ();
  65     destructor  Destroy (); override;
  66     procedure ReadByte (var x: Byte);
  67     procedure ReadWord (var x: Word);
  68     procedure ReadDWORD (var x: LongWord);
  69     procedure ReadShortInt (var x: ShortInt);
  70     procedure ReadSmallInt (var x: SmallInt);
  71     procedure ReadInt (var x: LongInt);
  72     procedure ReadSingle (var x: Single);
  73     procedure ReadBoolean (var x: Boolean);
  74     procedure ReadString (var x: AnsiString);
  75     procedure ReadMemory (var x: Pointer; var memSize: LongWord);
  76     procedure Skip (aLen: LongWord);
  77     procedure LoadFromFile (st: TStream);
  78     procedure LoadFromMemory (aMem: TBinMemoryReader);
  79   end;
  80
  81   TBinFileWriter = class
  82   private
  83     FHandle: TStream;
  84
  85   public
  86     constructor Create ();
  87     destructor Destroy (); override;
  88     procedure OpenFile (const aFileName: AnsiString; aFileSig: LongWord;
  89                         aFileVer: Byte; aOverWrite: Boolean=true);
  90     procedure Close ();
  91     procedure WriteMemory (aMemory: TBinMemoryWriter);
  92   end;
  93
  94   TBinFileReader = class
  95   private
  96     FHandle: TStream;
  97
  98   public
  99     constructor Create ();
 100     destructor Destroy (); override;
 101     function OpenFile (const aFileName: AnsiString; aFileSig: LongWord; aFileVer: Byte): Boolean;
 102     procedure Close ();
 103     procedure ReadMemory (aMemory: TBinMemoryReader);
 104   end;
 105
 106 procedure FillMemory (Dest: Pointer; Len: LongWord; Ch: Byte); inline;
 107 procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline;
 108 procedure ZeroMemory (Dest: Pointer; Len: LongWord); inline;
 109
 110
 111 implementation
 112
 113 uses
 114   Math, e_log, utils;
 115
 116 const
 117   MAX_BIN_SIZE = 42*1024*1024; // 42 MB
 118
 119
 120 procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline;
 121 begin
 122   Move(Src^, Dest^, Len);
 123 end;
 124
 125 procedure FillMemory (Dest: Pointer; Len: LongWord; Ch: Byte); inline;
 126 begin
 127   FillChar(Dest^, Len, Ch);
 128 end;
 129
 130 procedure ZeroMemory (Dest: Pointer; Len: LongWord); inline;
 131 begin
 132   FillChar(Dest^, Len, 0);
 133 end;
 134
 135
 136 { T B i n M e m o r y W r i t e r : }
 137
 138 constructor TBinMemoryWriter.Create (aSize: LongWord);
 139 begin
 140   if (aSize <= 0) then FSize := 1 else FSize := aSize;
 141   if (FSize > MAX_BIN_SIZE) then FSize := MAX_BIN_SIZE;
 142   GetMem(FData, FSize);
 143   FPosition := 0;
 144 end;
 145
 146 destructor TBinMemoryWriter.Destroy ();
 147 begin
 148   if (FData <> nil) then
 149   begin
 150     FreeMem(FData);
 151     FData := nil;
 152   end;
 153   inherited;
 154 end;
 155
 156 procedure TBinMemoryWriter.WriteVar (var x; varSize: LongWord);
 157 begin
 158   if (varSize > 0) then
 159   begin
 160     if (FPosition+varSize > FSize) then ExtendMemory(varSize);
 161     CopyMemory(Pointer(PtrUInt(FData)+FPosition), @x, varSize);
 162     FPosition := FPosition+varSize;
 163   end;
 164 end;
 165
 166 procedure TBinMemoryWriter.ExtendMemory (addLen: LongWord);
 167 var
 168   tmp: Pointer;
 169 begin
 170   while (FPosition+addLen > FSize) and (FSize <= MAX_BIN_SIZE) do FSize := FSize*2;
 171
 172   if (FSize > MAX_BIN_SIZE) then raise EBinSizeError.Create('TBinMemoryWriter.ExtendMemory: Tried to allocete more than 42 MB');
 173
 174   GetMem(tmp, FSize);
 175
 176   if (FPosition > 0) then CopyMemory(tmp, FData, FPosition);
 177
 178   FreeMem(FData);
 179   FData := tmp;
 180
 181   e_WriteLog('Save Memory Extended: '+IntToStr(FSize), MSG_NOTIFY);
 182 end;
 183
 184 procedure TBinMemoryWriter.WriteByte (x: Byte); begin WriteVar(x, sizeof(Byte)); end;
 185 procedure TBinMemoryWriter.WriteWord (x: Word); begin WriteVar(x, sizeof(Word)); end;
 186 procedure TBinMemoryWriter.WriteDWORD (x: LongWord); begin WriteVar(x, sizeof(LongWord)); end;
 187 procedure TBinMemoryWriter.WriteShortInt (x: ShortInt); begin WriteVar(x, sizeof(ShortInt)); end;
 188 procedure TBinMemoryWriter.WriteSmallInt (x: SmallInt); begin WriteVar(x, sizeof(SmallInt)); end;
 189 procedure TBinMemoryWriter.WriteInt (x: LongInt); begin WriteVar(x, sizeof(LongInt)); end;
 190 procedure TBinMemoryWriter.WriteSingle (x: Single); begin WriteVar(x, sizeof(Single)); end;
 191
 192 procedure TBinMemoryWriter.WriteBoolean (x: Boolean);
 193 var
 194   y: Byte;
 195 begin
 196   if x then y := 1 else y := 0;
 197   WriteVar(y, sizeof(Byte));
 198 end;
 199
 200 procedure TBinMemoryWriter.WriteString (const x: AnsiString; aMaxLen: Word=65535);
 201 var
 202   len: Word;
 203 begin
 204   if (Length(x) > aMaxLen) then len := aMaxLen else len := Word(Length(x));
 205
 206   if (FPosition+sizeof(Byte)+len) > FSize then ExtendMemory(sizeof(Byte)+len);
 207
 208   // Äëèíà ñòðîêè
 209   CopyMemory(Pointer(PtrUInt(FData)+FPosition), @len, sizeof(len));
 210   FPosition := FPosition+sizeof(len);
 211   // Ñòðîêà
 212   if (len > 0) then
 213   begin
 214     CopyMemory(Pointer(PtrUInt(FData) + FPosition), @x[1], len);
 215     FPosition := FPosition+len;
 216   end;
 217 end;
 218
 219 procedure TBinMemoryWriter.WriteMemory (x: Pointer; memSize: LongWord);
 220 begin
 221   if (FPosition+sizeof(LongWord)+memSize) > FSize then ExtendMemory(sizeof(LongWord)+memSize);
 222   // Äëèíà áëîêà ïàìÿòè
 223   CopyMemory(Pointer(PtrUInt(FData)+FPosition), @memSize, sizeof(LongWord));
 224   FPosition := FPosition+sizeof(LongWord);
 225   // Áëîê ïàìÿòè
 226   if (memSize > 0) then
 227   begin
 228     CopyMemory(Pointer(PtrUInt(FData)+FPosition), x, memSize);
 229     FPosition := FPosition+memSize;
 230   end;
 231 end;
 232
 233 procedure TBinMemoryWriter.Fill (aLen: LongWord; aFillSym: Byte);
 234 begin
 235   if (FPosition+aLen > FSize) then ExtendMemory(aLen);
 236   if (aLen > 0) then
 237   begin
 238     FillMemory(Pointer(PtrUInt(FData) + FPosition), aLen, aFillSym);
 239     FPosition := FPosition+aLen;
 240   end;
 241 end;
 242
 243 procedure TBinMemoryWriter.SaveToFile (st: TStream);
 244 begin
 245   // Ðàçìåð áëîêà
 246   utils.writeInt(st, LongWord(FPosition));
 247   // Äàííûå áëîêà
 248   if (FPosition > 0) then st.WriteBuffer(FData^, FPosition);
 249 end;
 250
 251 procedure TBinMemoryWriter.SaveToMemory (aMem: TBinMemoryWriter);
 252 begin
 253   if (aMem <> nil) then aMem.WriteMemory(FData, FPosition);
 254 end;
 255
 256
 257 { T B i n M e m o r y R e a d e r : }
 258
 259 constructor TBinMemoryReader.Create ();
 260 begin
 261   FSize := 0;
 262   FData := nil;
 263   FPosition := 1;
 264 end;
 265
 266 destructor TBinMemoryReader.Destroy ();
 267 begin
 268   if (FData <> nil) then
 269   begin
 270     FreeMem(FData);
 271     FData := nil;
 272   end;
 273   inherited;
 274 end;
 275
 276 procedure TBinMemoryReader.ReadVar (var x; varSize: LongWord);
 277 begin
 278   if (varSize = 0) then exit;
 279   if (FPosition+varSize > FSize) then raise EBinSizeError.Create('TBinMemoryReader.ReadVar: End of Memory');
 280   CopyMemory(@x, Pointer(PtrUInt(FData) + FPosition), varSize);
 281   FPosition := FPosition+varSize;
 282 end;
 283
 284 procedure TBinMemoryReader.ReadByte (var x: Byte); begin ReadVar(x, sizeof(Byte)); end;
 285 procedure TBinMemoryReader.ReadWord (var x: Word); begin ReadVar(x, sizeof(Word)); end;
 286 procedure TBinMemoryReader.ReadDWORD (var x: LongWord); begin ReadVar(x, sizeof(LongWord)); end;
 287 procedure TBinMemoryReader.ReadShortInt (var x: ShortInt); begin ReadVar(x, sizeof(ShortInt)); end;
 288 procedure TBinMemoryReader.ReadSmallInt (var x: SmallInt); begin ReadVar(x, sizeof(SmallInt)); end;
 289 procedure TBinMemoryReader.ReadInt (var x: LongInt); begin ReadVar(x, sizeof(LongInt)); end;
 290 procedure TBinMemoryReader.ReadSingle (var x: Single); begin ReadVar(x, sizeof(Single)); end;
 291
 292 procedure TBinMemoryReader.ReadBoolean (var x: Boolean);
 293 var
 294   y: Byte;
 295 begin
 296   ReadVar(y, sizeof(Byte));
 297   x := (y > 0);
 298 end;
 299
 300 procedure TBinMemoryReader.ReadString (var x: AnsiString);
 301 var
 302   len: Word;
 303 begin
 304   if (FPosition+sizeof(len)) <= FSize then
 305   begin
 306     // Äëèíà ñòðîêè
 307     CopyMemory(@len, Pointer(PtrUInt(FData)+FPosition), sizeof(len));
 308     if (FPosition+sizeof(len)+len <= FSize) then
 309     begin
 310       FPosition := FPosition+sizeof(len);
 311       // Ñòðîêà
 312       UniqueString(x);
 313       SetLength(x, len);
 314       if (len > 0) then
 315       begin
 316         CopyMemory(@x[1], Pointer(PtrUInt(FData) + FPosition), len);
 317         FPosition := FPosition+len;
 318       end
 319       else
 320       begin
 321         x := '';
 322       end;
 323     end
 324     else
 325     begin
 326       raise EBinSizeError.Create('TBinMemoryReader.ReadString: Too Long AnsiString');
 327     end;
 328   end
 329   else
 330   begin
 331     raise EBinSizeError.Create('TBinMemoryReader.ReadString: End of Memory');
 332   end;
 333 end;
 334
 335 procedure TBinMemoryReader.ReadMemory (var x: Pointer; var memSize: LongWord);
 336 begin
 337   if (FPosition+sizeof(LongWord) > FSize) then raise EBinSizeError.Create('TBinMemoryReader.ReadMemory: End of Memory');
 338   // Äëèíà áëîêà ïàìÿòè
 339   CopyMemory(@memSize, Pointer(PtrUInt(FData)+FPosition), sizeof(LongWord));
 340   if (FPosition+sizeof(LongWord)+memSize > FSize) then raise EBinSizeError.Create('TBinMemoryReader.ReadMemory: Too Long Memory');
 341   FPosition := FPosition+sizeof(LongWord);
 342   // Áëîê ïàìÿòè
 343   if (memSize > 0) then
 344   begin
 345     GetMem(x, memSize);
 346     CopyMemory(x, Pointer(PtrUInt(FData)+FPosition), memSize);
 347     FPosition += memSize;
 348   end
 349   else
 350   begin
 351     x := nil;
 352   end;
 353 end;
 354
 355 procedure TBinMemoryReader.Skip(aLen: LongWord);
 356 begin
 357   if (FPosition+aLen > FSize) then raise EBinSizeError.Create('TBinMemoryReader.Skip: End of Memory');
 358   FPosition += aLen;
 359 end;
 360
 361 procedure TBinMemoryReader.LoadFromFile (st: TStream);
 362 var
 363   aSize: LongWord;
 364 begin
 365   if (FData <> nil) then begin FreeMem(FData); FData := nil; end;
 366   // Ðàçìåð áëîêà
 367   aSize := utils.readLongWord(st);
 368   FSize := aSize;
 369   GetMem(FData, FSize);
 370   FPosition := 0;
 371   // Äàííûå áëîêà
 372   if (aSize <> 0) then st.ReadBuffer(FData^, FSize);
 373 end;
 374
 375
 376 procedure TBinMemoryReader.LoadFromMemory (aMem: TBinMemoryReader);
 377 begin
 378   if (FData <> nil) then begin FreeMem(FData); FData := nil; end;
 379   if (aMem <> nil) then
 380   begin
 381     aMem.ReadMemory(FData, FSize);
 382     FPosition := 0;
 383   end;
 384 end;
 385
 386
 387 { T B i n F i l e W r i t e r : }
 388
 389 constructor TBinFileWriter.Create ();
 390 begin
 391   FHandle := nil;
 392 end;
 393
 394 destructor TBinFileWriter.Destroy ();
 395 begin
 396   Close();
 397   inherited;
 398 end;
 399
 400 procedure TBinFileWriter.OpenFile (const aFileName: AnsiString; aFileSig: LongWord;
 401                                    aFileVer: Byte; aOverWrite: Boolean=true);
 402 begin
 403   Close();
 404   if (not FileExists(aFileName)) or aOverWrite then
 405   begin
 406     try
 407       FHandle := createDiskFile(aFileName);
 408       // Ñèãíàòóðà
 409       utils.writeInt(FHandle, LongWord(aFileSig));
 410       // Âåðñèÿ
 411       utils.writeInt(FHandle, Byte(aFileVer));
 412     except
 413       FHandle.Free();
 414       FHandle := nil;
 415       raise;
 416     end;
 417   end;
 418 end;
 419
 420 procedure TBinFileWriter.Close();
 421 begin
 422   if (FHandle <> nil) then
 423   begin
 424     FHandle.Free();
 425     FHandle := nil;
 426   end;
 427 end;
 428
 429 procedure TBinFileWriter.WriteMemory (aMemory: TBinMemoryWriter);
 430 begin
 431   if (FHandle <> nil) and (aMemory <> nil) then aMemory.SaveToFile(FHandle);
 432 end;
 433
 434
 435 { T B i n F i l e R e a d e r : }
 436
 437 constructor TBinFileReader.Create ();
 438 begin
 439   FHandle := nil;
 440 end;
 441
 442 destructor TBinFileReader.Destroy ();
 443 begin
 444   Close();
 445   inherited;
 446 end;
 447
 448 function TBinFileReader.OpenFile (const aFileName: AnsiString; aFileSig: LongWord; aFileVer: Byte): Boolean;
 449 var
 450   sig: LongWord;
 451   ver: Byte;
 452 begin
 453   result := false;
 454
 455   Close();
 456
 457   if FileExists(aFileName) then
 458   begin
 459     FHandle := openDiskFileRO(aFileName);
 460     try
 461       // Ñèãíàòóðà
 462       sig := utils.readLongWord(FHandle);
 463       if (sig <> aFileSig) then raise EInOutError.Create('TBinFileReader.OpenFile: Wrong File Signature');
 464       // Âåðñèÿ
 465       ver := utils.readByte(FHandle);
 466       if (ver <> aFileVer) then raise EInOutError.Create('TBinFileReader.OpenFile: Wrong File Version');
 467       result := true;
 468     except
 469       FHandle.Free();
 470       FHandle := nil;
 471       raise;
 472     end;
 473   end;
 474 end;
 475
 476 procedure TBinFileReader.Close ();
 477 begin
 478   if (FHandle <> nil) then
 479   begin
 480     FHandle.Free();
 481     FHandle := nil;
 482   end;
 483 end;
 484
 485 procedure TBinFileReader.ReadMemory (aMemory: TBinMemoryReader);
 486 begin
 487   if (FHandle <> nil) and (aMemory <> nil) then aMemory.LoadFromFile(FHandle);
 488 end;
 489
 490
 491 end.