⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 awinidb.pas

📁 测试用例
💻 PAS
📖 第 1 页 / 共 2 页
字号:
(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   AWINIDB.PAS 4.06                    *}
{*********************************************************}
{* Deprecated INI file database                          *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$X+,V-,B-,I-}

unit AwIniDB;
  {-INI file database management }

interface

uses
  SysUtils,
  WinTypes,
  WinProcs,
  Classes,
  OoMisc;

procedure iInitIniDatabase(var Ini : PIniDatabase; FName : PChar);
  {-Initialize an .INI file database }

procedure iDoneIniDatabase(var Ini : PIniDatabase);
  {-Destroy an .INI file database }

function iAddIniDBStringField(Ini       : PIniDatabase;
                              FieldName : PChar; MaxLen : Cardinal;
                              Index     : Bool) : Integer;
  {-Add a string field to the .INI file database }

function iAddIniDBIntField(Ini : PIniDatabase; FieldName : PChar) : Integer;
  {-Add an integer field to the .INI file database }

function iPrepareIniDatabase(Ini : PIniDatabase; Defaults : Pointer) : Integer;
  {-Prepare the databse for reading/writing }

function iChangeIniDefaults(Ini : PIniDatabase; var DefaultRec) : Integer;
  {-Change the default values for record fields }

function iKeyExists(Ini : PIniDatabase; Key : PChar) : Bool;
  {-Return TRUE if an entry with an index of 'Name' exists }

function iAddIniRecord(Ini : PIniDatabase; var Rec) : Integer;
  {-Add a record to the database }

function iUpdIniRecord(Ini : PIniDatabase; Key : PChar; var Rec) : Integer;
  {-Update a record in the database }

function iDelIniRecord(Ini : PIniDatabase; Key : PChar) : Integer;
  {-Remove a record from the database }

function iGetIniRecord(Ini : PIniDatabase; Key : PChar; var Rec) : Integer;
  {-Get a record from the database }

function iGetIniIndexRecSize(Ini : PIniDatabase) : Integer;
  {-Get the size of the .INI index buffer }

function iAllocIniIndexRec(     Ini     : PIniDatabase;
                            var IRec    : PChar;
                            var BufSize : Integer) : Integer;
  {-Allocate a buffer for the record index }

procedure iDeallocIniIndexRec(     Ini     : PIniDatabase;
                               var IRec    : PChar;
                                   BufSize : Integer );
  {-Deallocate an index buffer }

function iLoadIniIndex(Ini : PIniDatabase; Buf : PChar; BufSize : Integer) : Integer;
  {-Load the INI index into Buf }

function iNumIniRecs(Ini : PIniDatabase) : Integer;
  {-Return the number of records in an INI database }

function iWriteToIni(Ini : PIniDatabase; var Rec; Section, IniFile : PChar) : Integer;
  {-Write the record to a user-specified .INI file }

function iReadFromIni(Ini : PIniDatabase; var Rec; Section, IniFile : PChar) : Integer;
  {-Read the record from a user-specified .INI file }

implementation

  procedure iInitIniDatabase(var Ini : PIniDatabase; FName : PChar);
    {-Initialize a .INI file database }
  begin

    Ini := AllocMem(SizeOf(TIniDatabase));

    Ini^.FName := AllocMem(StrLen(FName) + 1);

    StrCopy(Ini^.FName, FName);

    with Ini^ do begin
      DictionaryHead := nil;
      DictionaryTail := nil;
      NumRecords     := 0;
      RecordSize     := 0;
      DefaultRecord  := nil;
      Prepared       := False;
    end;

  end;

  procedure iDoneIniDatabase(var Ini : PIniDatabase);
    {-Destroy an .INI file database }
  var
    Temp : PIniDatabaseKey;

  begin
    with Ini^ do begin
      FreeMem(FName, StrLen(FName) + 1);
      while (DictionaryHead <> nil) do begin
        Temp := DictionaryHead^.Next;
        FreeMem(DictionaryHead^.KeyName, StrLen(DictionaryHead^.KeyName) + 1);
        FreeMem(DictionaryHead, SizeOf(TIniDatabaseKey));
        DictionaryHead := Temp;
      end;

      FreeMem(DefaultRecord, RecordSize);
    end;

    FreeMem(Ini, SizeOf(TIniDatabase));
  end;

  function iAddIniKeyPrim(Ini       : PIniDatabase;
                          AKeyName  : PChar;
                          AStrType  : Bool;
                          AIndex    : Bool;
                          ADataSize : Cardinal) : Integer;
    {-Add an .INI key with these attributes to the dictionary }
  var
    NewKey : PIniDatabaseKey;

  begin
    if ((DWORD(Ini^.RecordSize) + ADataSize) > $FFF0) or
        (AIndex and (Pred(ADataSize) > MaxIndexLen)) then begin
      iAddIniKeyPrim := ecDataTooLarge;
      Exit;
    end;

    if (StrLen(AKeyName) > MaxNameLen) then begin
      iAddIniKeyPrim := ecKeyTooLong;
      Exit;
    end;

    NewKey := AllocMem(SizeOf(TIniDatabaseKey));

    NewKey^.KeyName := AllocMem(StrLen(AKeyName) + 1);

    StrCopy(NewKey^.KeyName, AKeyName);

    with Ini^, NewKey^ do begin
      DataSize := ADataSize;
      StrType  := AStrType;
      Index    := AIndex;
      Next     := nil;

      if (DictionaryHead = nil) then begin
        DictionaryHead := NewKey;
        DictionaryTail := NewKey;
      end else begin
        DictionaryTail^.Next := NewKey;
        DictionaryTail       := NewKey;
      end;

      Inc(RecordSize, DataSize);
    end;

    iAddIniKeyPrim := ecOK;
  end;

  function iAddIniDBStringField(  Ini       : PIniDatabase;
                                  FieldName : PChar; MaxLen : Cardinal;
                                  Index     : Bool) : Integer;
    {-Add a string field to the .INI file database }
  begin
    iAddIniDBStringField := iAddIniKeyPrim(Ini, FieldName, True, Index, MaxLen + 1);
  end;

  function iAddIniDBIntField(Ini : PIniDatabase; FieldName : PChar) : Integer;
    {-Add an integer field to the .INI file database }
  begin
    iAddIniDBIntField := iAddIniKeyPrim(Ini, FieldName, False, False, SizeOf(Integer));
  end;

  function IniIndexKey(Ini : PIniDatabase) : PIniDatabaseKey;
    {-Return a pointer to the indexed key }
  var
    CurItem : PIniDatabaseKey;

  begin
    with Ini^ do begin
      CurItem := DictionaryHead;
      while (CurItem <> nil) do begin
        if CurItem^.Index then begin
          IniIndexKey := CurItem;
          Exit;
        end;
        CurItem := CurItem^.Next;
      end;
      IniIndexKey := nil;
    end;
  end;

  function iPrepareIniDatabase(Ini : PIniDatabase; Defaults : Pointer) : Integer;
    {-Prepare the databse for reading/writing }
  var
    CurItem   : PIniDatabaseKey;
    TempRec   : Pointer;
    Code      : Integer;
    TempStr   : array[0..5] of Char;
    TempFName : array[0..255] of Char;
    Existed   : Bool;

  begin
    with Ini^ do begin
      { if there are no items defined, it's an error }
      if (DictionaryHead = nil) then begin
        iPrepareIniDatabase := ecNoFieldsDefined;
        Exit;
      end;

      if (IniIndexKey(Ini) = nil) then begin
        iPrepareIniDatabase := ecNoIndexKey;
        Exit;
      end;

      { allocate the default data record }
      DefaultRecord := AllocMem(RecordSize);

      Existed := ExistFileZ(FName);
      if not Existed then begin
        JustFileNameZ(TempFName, FName);

        {is filename unqualified?}
        if (StrComp(TempFName, FName) = 0) then begin
          GetWindowsDirectory(TempFName, 255);
          AddBackslashZ(TempFName, TempFName);
          StrCat(TempFName, FName);
          Existed := ExistFileZ(TempFName);
        end;
      end;

      { if the .INI file doesn't exist, create a default one }
      if not Existed then begin
        { create the index section }
        if not WritePrivateProfileString( dbIndex,
                                          dbBogus,
                                          dbBogus,
                                          FName ) then begin
          iPrepareIniDatabase := ecIniWrite;
          FreeMem(DefaultRecord, RecordSize);
          Exit;
        end;

        if not WritePrivateProfileString( dbIndex,
                                          dbBogus,
                                          nil,
                                          FName ) then begin
          iPrepareIniDatabase := ecIniWrite;
          FreeMem(DefaultRecord, RecordSize);
          Exit;
        end;

        { create the defaults section }
        if not WritePrivateProfileString( dbDefaults,
                                          dbNumEntries,
                                          Long2StrZ(TempStr, NumRecords),
                                          FName ) then begin
          iPrepareIniDatabase := ecIniWrite;
          FreeMem(DefaultRecord, RecordSize);
          Exit;
        end;

        if (Defaults <> nil) then begin
          Prepared := True;
          Code := iChangeIniDefaults(Ini, Defaults^);
          if (Code < ecOK) then begin
            Prepared := False;
            iPrepareIniDatabase := Code;
            FreeMem(DefaultRecord, RecordSize);
            Exit;
          end;
        end;

        NumRecords := 0;
      end else begin
        { load the number of database entries }
        NumRecords := GetPrivateProfileInt( dbDefaults,
                                            dbNumEntries,
                                            0, FName );

        { load the default record }
        TempRec := DefaultRecord;
        CurItem := DictionaryHead;
        while (CurItem <> nil) do begin
          if not CurItem^.Index then
            if CurItem^.StrType then
              GetPrivateProfileString(  dbDefaults,
                                        CurItem^.KeyName,
                                        '', PChar(TempRec),
                                        CurItem^.DataSize,
                                        FName )
            else
              Integer(TempRec^) := GetPrivateProfileInt(  dbDefaults,
                                                          CurItem^.KeyName,
                                                          0, FName );

          TempRec := AddWordToPtr(TempRec, CurItem^.DataSize);
          CurItem := CurItem^.Next;
        end;
      end;

      Prepared := True;
    end;

    iPrepareIniDatabase := ecOK;
  end;

  function iChangeIniDefaults(Ini : PIniDatabase; var DefaultRec) : Integer;
    {-Change the default values for record fields }
  var
    CurItem : PIniDatabaseKey;
    TempRec : Pointer;
    TempStr : array[0..5] of Char;

  begin
    with Ini^ do begin
      { if there are no items defined, it's an error }
      if (DictionaryHead = nil) then begin
        iChangeIniDefaults := ecNoFieldsDefined;
        Exit;
      end;

      if not Prepared then begin
        iChangeIniDefaults := ecDatabaseNotPrepared;
        Exit;
      end;

      Move(DefaultRec, DefaultRecord^, RecordSize);

      TempRec := DefaultRecord;
      CurItem := DictionaryHead;
      while (CurItem <> nil) do begin
        if not CurItem^.Index then
          if CurItem^.StrType then begin
            if not WritePrivateProfileString( dbDefaults,
                                              CurItem^.KeyName,
                                              PChar(TempRec),
                                              FName ) then begin
              iChangeIniDefaults := ecIniWrite;
              Exit;
            end
          end else begin
            if not WritePrivateProfileString( dbDefaults,
                                              CurItem^.KeyName,
                                              Long2StrZ(TempStr, Integer(TempRec^)),
                                              FName ) then begin
              iChangeIniDefaults := ecIniWrite;
              Exit;
            end;
          end;

        TempRec := AddWordToPtr(TempRec, CurItem^.DataSize);
        CurItem := CurItem^.Next;
      end;
    end;

    iChangeIniDefaults := ecOK;
  end;

  function iKeyExists(Ini : PIniDatabase; Key : PChar) : Bool;
    {-Return TRUE if an entry with an index of 'Name' exists }
  var
    Temp : array[0..5] of Char;

  begin
    if not Ini^.Prepared then begin
      iKeyExists := False;
      Exit;
    end;

    GetPrivateProfileString(dbIndex, Key, '', Temp, SizeOf(Temp), Ini^.FName);
    iKeyExists := (StrComp(Temp, NonValue) = 0);
  end;

  function iGetIniDataString(Ini : PIniDatabase; var Rec; Key : PIniDatabaseKey) : PChar;
    {-Get a string from an INI data record }
  var
    CurItem : PIniDatabaseKey;
    TempRec : Pointer;

  begin
    with Ini^ do begin
      CurItem := DictionaryHead;
      TempRec := @Rec;
      while (CurItem <> nil) and (CurItem <> Key) do begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -