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: 432: 433: 434: 435: 436: 437: 438: 439: 440: 441: 442: 443: 444: 445: 446: 447: 448: 449: 450: 451: 452: 453: 454: 455: 456: 457: 458: 459: 460: 461: 462: 463: 464: 465: 466: 467: 468: 469: 470: 471: 472: 473: 474: 475: 476: 477: 478: 479: 480: 481: 482: 483: 484: 485: 486: 487: 488: 489: 490: 491: 492: 493: 494: 495: 496: 497: 498: 499: 500: 501: 502: 503: 504: 505: 506: 507: 508: 509: 510: 511: 512: 513: 514: 515: 516: 517: 518: 519: 520: 521: 522: 523: 524: 525: 526: 527: 528: 529: 530: 531: 532: 533: 534: 535: 536: 537: 538: 539: 540: 541: 542: 543: 544: 545: 546: 547: 548: 549:
| unit DataFile;
interface
uses Windows, SysUtils, Classes;
const MAX_NAMELEN = 36; MAXPATHLEN = 240;
type IDENTNAME = array[0..MAX_NAMELEN - 1]of Char;
pDataHdr = ^IDataHdr; IDataHdr = packed record Id : Integer; Section : IDENTNAME; Ident : IDENTNAME; Size : Integer; end;
TDataFile = class(TObject) private FFile: TFileStream; FFileName: string; FCodeKey: string; function GetSectionCount: Integer; procedure XorBuffer(pBuf: Pointer; Count: integer); function FindIdent(Section, Ident: string; pHdr: pDataHdr): boolean; public constructor Create(const FileName: string); destructor Destroy; override; procedure GetSectionNames(List: TStrings); procedure GetValueNames(Section: string; List: TStrings); function SectionExists(Section: string): Boolean; function ValueExists(Section, Ident: string): Boolean; function ReadData(Section, Ident: string; pBuf: Pointer): Integer; function ReadStream(Section, Ident: string; Stream: TStream): Integer; function ReadString(Section, Ident, Default: string): string; function ReadInteger(Section, Ident: string; Default: Integer): Integer; function ReadDouble(Section, Ident: string; Default: Double): Double; function ReadExtended(Section, Ident: string; Default: Extended): Extended; function ReadDateTime(Section, Ident: string; Default: TDateTime): TDateTime; function ReadBoolean(Section, Ident: string; Default: Boolean): Boolean; procedure ReadStrings(Section, Ident: string; List: TStrings); function WriteData(Section, Ident: string; pBuf: Pointer; Count: Integer): Integer; function WriteStream(Section, Ident: string; Stream: TStream): Integer; procedure WriteString(Section, Ident, Value: string); procedure WriteInteger(Section, Ident: string; Value: Integer); procedure WriteDouble(Section, Ident: string; Value: Double); procedure WriteExtended(Section, Ident: string; Value: Extended); procedure WriteDateTime(Section, Ident: string; Value: TDateTime); procedure WriteBoolean(Section, Ident: string; Value: Boolean); procedure WriteStrings(Section, Ident: string; List: TStrings); procedure Delete(Section, Ident: string); procedure DeleteSection(Section: string); property CodeKey: string read FCodeKey write FCodeKey; property FileName: string read FFileName; property SectionCount: Integer read GetSectionCount; end;
implementation
const HDR_IDENT = $112;
constructor TDataFile.Create(const FileName: string); var OpenMode: integer; begin FFileName := FileName; if FileExists(FFileName)then OpenMode := fmOpenReadWrite or fmShareDenyNone else OpenMode := fmCreate or fmShareDenyNone; FFile := TFileStream.Create(FileName, OpenMode); FCodeKey := 'hDmpSwrdGZxqlHdgfcIRuHsDHs5Tu'; end;
destructor TDataFile.Destroy; begin if Assigned( FFile )then FFile.Free; end;
function TDataFile.FindIdent(Section, Ident: string; pHdr: pDataHdr): boolean; var Sect : string; Iden : string; Count : integer; IsError : boolean; begin IsError := False; Result := False; FFile.Seek(0, soFromBeginning); repeat Count := FFile.Read(pHdr^, SizeOf(IDataHdr)); if( Count <> SizeOf(IDataHdr))then Break; XorBuffer(pHdr, SizeOf(IDataHdr)); if( pHdr^.ID <> HDR_IDENT )then begin IsError := True; Break; end; Sect := pHdr^.Section; Iden := pHdr^.Ident; Result := ( ANSICompareText(Sect, Section) = 0 )and (( ANSICompareText(Iden, Ident) = 0 )or ( Ident = '' )); if( Result )then Break; FFile.Seek(pHdr^.Size, soFromCurrent); until( False ); if( IsError )then raise EInvalidOperation.Create('Invalid file format.'); end;
procedure TDataFile.XorBuffer(pBuf: Pointer; Count: Integer); var I: Integer; p: pBYTE; begin p := pBuf; if( FCodeKey <> '' )then for I := 0 to Count - 1 do begin p^ := Byte(FCodeKey[1 + ((I - 1) mod Length(FCodeKey))]) xor p^; inc(p); end; end;
function TDataFile.GetSectionCount: Integer; var Hdr : IDataHdr; Count : integer; IsError: boolean; begin IsError := False; Result := 0; FFile.Seek(0, soFromBeginning); repeat Count := FFile.Read(Hdr, SizeOf(IDataHdr)); if( Count <> SizeOf(IDataHdr))then Break; XorBuffer(pBYTE(@Hdr), SizeOf(IDataHdr)); if( Hdr.ID <> HDR_IDENT )then begin IsError := True; Break; end else inc(Result); FFile.Seek(Hdr.Size, soFromCurrent); until( False ); if( IsError )then raise EInvalidOperation.Create('Invalid file format.'); end;
procedure TDataFile.GetSectionNames(List: TStrings); var Hdr : IDataHdr; Count : integer; IsError: boolean; begin IsError := False; List.Clear; FFile.Seek(0, soFromBeginning); repeat Count := FFile.Read(Hdr, SizeOf(IDataHdr)); if( Count <> SizeOf(IDataHdr))then Break; XorBuffer(pBYTE(@Hdr), SizeOf(IDataHdr)); if( Hdr.ID <> HDR_IDENT )then begin IsError := True; Break; end else if( List.IndexOf(Hdr.Section) = -1 )then List.Add(Hdr.Section); FFile.Seek(Hdr.Size, soFromCurrent); until( False ); if( IsError )then raise EInvalidOperation.Create('Invalid file format.'); end;
procedure TDataFile.GetValueNames(Section: string; List: TStrings); var Hdr : IDataHdr; Count : integer; IsError: boolean; begin IsError := False; List.Clear; FFile.Seek(0, soFromBeginning); repeat Count := FFile.Read(Hdr, SizeOf(IDataHdr)); if( Count <> SizeOf(IDataHdr))then Break; XorBuffer(pBYTE(@Hdr), SizeOf(IDataHdr)); if( Hdr.ID <> HDR_IDENT )then begin IsError := True; Break; end else if ANSICompareText(Section, Hdr.Section) = 0 then List.Add(Hdr.Ident); FFile.Seek(Hdr.Size, soFromCurrent); until( False ); if( IsError )then raise EInvalidOperation.Create('Invalid file format.'); end;
function TDataFile.SectionExists(Section: string): Boolean; var Hdr: IDataHdr; begin Result := FindIdent(Section, '', @Hdr); end;
function TDataFile.ValueExists(Section, Ident: string): Boolean; var Hdr: IDataHdr; begin Result := FindIdent(Section, Ident, @Hdr); end;
function TDataFile.ReadData(Section, Ident: string; pBuf: Pointer): Integer; var Found : boolean; Hdr : IDataHdr; begin Found := FindIdent(Section, Ident, @Hdr); if( Found )then begin Result := FFile.Read(pBuf^, Hdr.Size); XorBuffer(pBuf, Hdr.Size); end else Result := -1; end;
function TDataFile.ReadStream(Section, Ident: string; Stream: TStream): Integer; var Hdr : IDataHdr; pBuf : Pointer; begin if( FindIdent(Section, Ident, @Hdr) )then begin Result := Hdr.Size; try GetMem(pBuf, Result); FFile.Read(pBuf^, Result); XorBuffer(pBuf, Result); Stream.Size := 0; Stream.Write(pBuf^, Result); Stream.Seek(0, soFromBeginning); finally FreeMem(pBuf, Result); end; end else Result := -1; end;
function TDataFile.ReadString(Section, Ident, Default: string): string; var Buf : TMemoryStream; pBuf : PChar; Count : Integer; begin try Buf := TMemoryStream.Create; Count := ReadStream(Section, Ident, Buf); if( Count > -1 )then begin pBuf := StrAlloc(Count); Buf.Seek(0, soFromBeginning); Buf.Read(pBuf^, Count); Result := StrPas(pBuf); end else Result := Default; finally Buf.Free; end; end;
function TDataFile.ReadInteger(Section, Ident: string; Default: Integer): Integer; var Buf : array[0..1023]of Char; Count : Integer; begin Count := ReadData(Section, Ident, @Buf); if( Count >= SizeOf(Integer) )then Move(Buf, Result, SizeOf(Integer)) else Result := Default; end;
function TDataFile.ReadDouble(Section, Ident: string; Default: Double): Double; var Buf : array[0..1023]of Char; Count : Integer; begin Count := ReadData(Section, Ident, @Buf); if( Count >= SizeOf(Double) )then Move(Buf, Result, SizeOf(Double)) else Result := Default; end;
function TDataFile.ReadExtended(Section, Ident: string; Default: Extended): Extended; var Buf : array[0..1023]of Char; Count : Integer; begin Count := ReadData(Section, Ident, @Buf); if( Count >= SizeOf(Extended) )then Move(Buf, Result, SizeOf(Extended)) else Result := Default; end;
function TDataFile.ReadDateTime(Section, Ident: string; Default: TDateTime): TDateTime; var Buf : array[0..1023]of Char; Count : Integer; begin Count := ReadData(Section, Ident, @Buf); if( Count >= SizeOf(TDateTime) )then Move(Buf, Result, SizeOf(TDateTime)) else Result := Default; end;
function TDataFile.ReadBoolean(Section, Ident: string; Default: Boolean): Boolean; var Buf : array[0..1023]of Char; Count : Integer; begin Count := ReadData(Section, Ident, @Buf); if( Count >= SizeOf(Boolean) )then Move(Buf, Result, SizeOf(Boolean)) else Result := Default; end;
procedure TDataFile.ReadStrings(Section, Ident: string; List: TStrings); var Buf : TMemoryStream; Count : Integer; begin try List.Clear; Buf := TMemoryStream.Create; Count := ReadStream(Section, Ident, Buf); if( Count > -1 )then List.LoadFromStream( Buf ); finally Buf.Free; end; end;
function TDataFile.WriteData(Section, Ident: string; pBuf: Pointer; Count: Integer): Integer; var Hdr : IDataHdr; P : Pointer; begin Delete(Section, Ident); FFile.Seek(0, soFromEnd); Hdr.Id := HDR_IDENT; StrPCopy(Hdr.Section, Section); StrPCopy(Hdr.Ident, Ident); Hdr.Size := Count; XorBuffer(@Hdr, SizeOf(IDataHdr)); Result := FFile.Write(Hdr, SizeOf(IDataHdr)); if( Result > -1 )then begin try GetMem(P, Count); Move(pBuf^, P^, Count); XorBuffer(P, Count); Result := FFile.Write(P^, Count); finally FreeMem(P, Count); end; end; end;
function TDataFile.WriteStream(Section, Ident: string; Stream: TStream): Integer; var pBuf : Pointer; begin try GetMem(pBuf, Stream.Size); Stream.Seek(0, soFromBeginning); Stream.Read(pBuf^, Stream.Size); Result := WriteData(Section, Ident, pBuf, Stream.Size); finally FreeMem(pBuf, Stream.Size); end; end;
procedure TDataFile.WriteString(Section, Ident, Value: string); var pBuf : pChar; begin try pBuf := StrNew(PChar(Value)); WriteData(Section, Ident, pBuf, StrLen(pBuf) + 1); finally StrDispose(pBuf); end; end;
procedure TDataFile.WriteInteger(Section, Ident: string; Value: Integer); begin WriteData(Section, Ident, @Value, SizeOf(Integer)); end;
procedure TDataFile.WriteDouble(Section, Ident: string; Value: Double); begin WriteData(Section, Ident, @Value, SizeOf(Double)); end;
procedure TDataFile.WriteExtended(Section, Ident: string; Value: Extended); begin WriteData(Section, Ident, @Value, SizeOf(Extended)); end;
procedure TDataFile.WriteDateTime(Section, Ident: string; Value: TDateTime); begin WriteData(Section, Ident, @Value, SizeOf(TDateTime)); end;
procedure TDataFile.WriteBoolean(Section, Ident: string; Value: Boolean); begin WriteData(Section, Ident, @Value, SizeOf(Boolean)); end;
procedure TDataFile.WriteStrings(Section, Ident: string; List: TStrings); var Buf : TMemoryStream; Count : Integer; begin try Buf := TMemoryStream.Create; List.SaveToStream( Buf ); WriteStream(Section, Ident, Buf); finally Buf.Free; end; end;
procedure TDataFile.Delete(Section, Ident: string); var BufPos : Integer; HdrPos : Integer; EndPos : Integer; FileSize : Integer; Count : Integer; Hdr : IDataHdr; pBuf : Pointer; begin if( FindIdent(Section, Ident, @Hdr) )then begin FileSize := FFile.Size; BufPos := FFile.Position; HdrPos := BufPos - SizeOf(IDataHdr); EndPos := FFile.Seek(Hdr.Size, soFromCurrent); Count := FileSize - EndPos; try GetMem(pBuf, Count); FFile.Read(pBuf^, Count); FFile.Seek(HdrPos, soFromBeginning); FFile.Write(pBuf^, Count); FFile.Size := FileSize - ( Hdr.Size + SizeOf(IDataHdr) ); finally FreeMem(pBuf, Count); end; end; end;
procedure TDataFile.DeleteSection(Section: string); var BufPos : Integer; HdrPos : Integer; EndPos : Integer; Size : Integer; Count : Integer; Hdr : IDataHdr; pBuf : Pointer; begin while FindIdent(Section, '', @Hdr)do begin Size := FFile.Size; BufPos := FFile.Position; HdrPos := BufPos - SizeOf(IDataHdr); EndPos := FFile.Seek(Hdr.Size, soFromCurrent); Count := Size - EndPos; try GetMem(pBuf, Count); FFile.Read(pBuf^, Count); FFile.Seek(HdrPos, soFromBeginning); FFile.Write(pBuf^, Count); FFile.Size := Size - ( Hdr.Size + SizeOf(IDataHdr) ); finally FreeMem(pBuf, Count); end; end; end;
end. |